We’ve all got stacks of legacy code that has a huge amount of business logic locked away full of those pesky do loops with their setll’s and reads followed by endless hops off to do some chain statements grabbing all the accompanying supporting data.
Well at least by deploying some SQL we can make that job a bit less painful when we need to roll out a new report or do some life saving support on an old program. You often find that performance is improved as well with SQL able to swallow large data sets easier than many individual reads and chains. On an old Power 6 8203 E4A, with a SAS disk array and maxed out memory, it can process selections and joins from multiple hundred thousand plus record tables in less than a few seconds.
Below is an example of a typical RPG program that we may stumble across when having to modify some really, really old (and probably forgotten) IBM MAAPICS code where it reads the transaction history file IMHIST and then gets master file records to check stock levels etc.
H
* PROGRAM - Read IMHIST and get ITEMAS, ITEMBL and SLAMAST records
FIMHIST IF F 300 28AIDISK KEYLOC(17)
FITEMAS IF F 422 16AIDISK KEYLOC(2)
FITEMBL IF F 467 16AIDISK KEYLOC(4)
FSLMAST IF F 64 15AIDISK KEYLOC(3)
DIMHSTK S 28
DROW S 30
D DS
DITEMSK 1 16
DITNBR1 1 15
DRECID 16 16
D DS
DITMBLK 1 16
DITNBR2 1 15
DHOUSE 16 16
IIMHIST NS
I 1 2 RECCD
I 3 3 ACREC
I 8 9 TCODE
I 17 31 ITNBR1
I 17 31 ITNBR2
I 32 32 HOUSE
IITEMAS NS
I 135 135 ITTYP
IITEMBL NS
I P 94 97 0SAFTY
ISLMAST NS
I P 19 24 3PTBQY
C EVAL RECID='A'
* Read inventory management history file
C IMHSTK SETLL IMHIST
C READ IMHIST 99
C *IN99 DOWEQ *OFF
C RECCD IFNE 'TR'
C ACREC ORNE 'A'
C ITER
C END
* Get item master record
C ITEMSK CHAIN ITEMAS 99
C 99 EVAL ITTYP=' '
C ITTYP IFNE '1'
C ITTYP ANDNE '2'
C ITER
C END
* Get item balance record
C ITMBLK CHAIN ITEMBL 99
C 99 EVAL SAFTY=0
C SAFTY IFLE 2000
C ITER
C END
* Get stock location master record
C ITNBR1 CHAIN SLMAST 99
C 99 EVAL PTBQY=0
C PTBQY IFLT 4000
C ITER
C END
C EVAL ROW=%TRIM(ITNBR1)+','+%EDITC(PTBQY:'Q')+','+TCODE+
C %EDITC(SAFTY)+','+%TRIM(ITTYP)
C READ IMHIST 99
C N99 ENDDO
C EVAL *INLR=*ON
C RETURN
Now here’s the money shot. Effectively one line of SQL replaces the setll, read and chain logic in the old style RPG IV code above.
**free
// Read IMHIST and get ITEMAS, ITEMBL and SLMAST records
ctl-opt dftactgrp(*NO) option(*NOSHOWCPY:*NODEBUGIO) alwnull(*INPUTONLY) fixnbr(*ZONED:*INPUTPACKED);
dcl-ds IMHIST# extname('IMHIST') prefix('PD#') end-ds;
dcl-ds ITEMAS# extname('ITEMAS') prefix('PS#') end-ds;
dcl-ds ITEMBL# extname('ITEMBL') prefix('IT#') end-ds;
dcl-ds ISLMAST extname('ISLMAS') prefix('ID#') end-ds;
dcl-s #a int(10);
dcl-s #resultSet int(10) inz(32766);
dcl-s row char(2056);
dcl-ds resultSetDS occurs(32766);
ITNBR like(IM#ITNBR);
TCODE like(IM#TCODE);
ITTYP like(IT#ITTYP);
SAFTY like(IB#SAFTY);
PTBQY like(SL#PTBQY);
end-ds;
// Read inventory management history file and get ITEMAS, ITEMBL and SLMAST records at the same time using one SQL statement
exec sql DECLARE C1 CURSOR FOR
SELECT IM.ITNBR,IM.TCODE,
IFNULL(IT.ITTYP,' '),
IFNULL(IB.SAFTY,'0'),
IFNULL(SL.PTBQY,'0')
FROM IMHIST AS IM INNER JOIN ITEMAS AS IT
ON IM.ITNBR=IT.ITNBR
LEFT JOIN ITEMBL IB
ON IM.ITNBR=IB.ITNBR
LEFT JOIN SLMAST SL
ON IM.ITNBR=SL.ITNBR
WHERE ACREC='A' AND TRCOD='TR' AND (IT.ITTYP='1' OR IT.ITTYP='2') AND IB.SAFTY>2000 AND SL.PTBQY>4000
ORDER BY IM.ITNBR
FOR READ ONLY OPTIMIZE FOR 32766 ROWS WITH NC;
exec sql OPEN C1;
dow #resultSet=32766;
exec sql FETCH NEXT FROM C1 FOR 32766 ROWS INTO :resultSetDS;
#resultSet=SQLERRD(3);
if #RESULTSET>0;
exsr processResultSet;
endif;
enddo;
exec sql CLOSE C1;
*INLR=*ON;
return;
begsr processResultSet;
for #a=1 to #resultSet by 1; // Read thru returned dataset rows
%occur(resultSetDS)=#a;
row=%trim(ITNBR1)+','+%char(PTBQY:'Q')+','+TCODE+%char(SAFTY)+','+ITTYP;
endfor;
endsr;
Note the IFNULL function that populates the column in the row with the specified value should there not be a match on the join definition. While there are more the 32766 rows returned in the result set there is a do loop defined to process each fetch set until the selection is exausted.