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.