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.