autotests/folding/qrpg.test.fold

0001       * "F" (file) specs define files and other i/o devices
0002      F ARMstF1   IF   E       K     Disk    Rename(ARMST:RARMST)
0003
0004       * "D" (data) specs are used to define variables
0005      D pCusNo          S              6p
0006      D pName           S             30a
0007      D pAddr1          S             30a
0008
0009       * The "chain" command is used for random access of a keyed file
0010      C     pCusNo        chain     ARMstF1
0011
0012       * If a record is found, move fields from the file into parameters
0013      C                   if        %found
0014      C                   eval      pName  = ARNm01
0015      C                   eval      pAddr1 = ARAd01
0016      C                   eval      pAddr2 = ARAd02
0017      C                   eval      pCity  = ARCy01
0018      C                   endif
0019
0020       * RPG makes use of switches.  One switch "LR" originally stood for "last record"
0021       * LR flags the program and its dataspace as removable from memory
0022
0023      C                   eval      *InLR = *On
0024
0025       * "F" (file) specs define files and other i/o devices
0026      FARMstF1   IF   E        K     Disk    Rename(ARMST:RARMST)
0027
0028       * "D" (data) specs are used to define variables and parameters
0029       * The "prototype" for the program is in a separate file
0030       * allowing other programs to call it
0031       /copy cust_pr
0032       * The "procedure interface" describes the *ENTRY parameters
0033      D getCustInf      PI
0034      D  pCusNo                        6p 0   const
0035      D  pName                        30a
0036      D  pAddr1                       30a
0037      D  pAddr2                       30a
0038      D  pCity                        25a
0039      D  pState                        2a
0040      D  pZip                         10a
0041       /free
0042         // The "chain" command is used for random access of a keyed file
0043         chain pCusNo ARMstF1;
0044
0045         // If a record is found, move fields from the file into parameters
0046         if %found;
0047            pName  = ARNm01;
0048            pAddr1 = ARAd01;
0049            pAddr2 = ARAd02;
0050            pCity  = ARCy01;
0051            pState = ARSt01;
0052            pZip   = ARZp15;
0053         endif;
0054
0055       // RPG makes use of switches.  One switch "LR" originally stood for "last record"
0056       // LR actually flags the program and its dataspace as removable from memory.
0057         *InLR = *On;
0058       /end-free
0059
0060      H main(GetCustInf)
0061      D ARMSTF1       E DS
0062      P GetCustInf      B
0063      D GetCustInf      PI                  extpgm('CUS001')
0064      D  inCusNo                            like(arCNum) const
0065      D  outName                            like(arName)
0066      D  outAddr1                           like(arAdd1)
0067      D  outAddr2                           like(arAdd2)
0068      D  outCity                            like(arCity)
0069      D  outState                           like(arStte)
0070      D  outZip                             like(arZip)
0071       /free
0072        exec sql select arName, arAdd1, arAdd2, arCity, arStte, arZip
0073                 into  :outName, :outAddr1, :outAddr2, :outCity, :outState,
0074                       :outZip
0075                 from   ARMSTF1
0076                 where  arCNum = :inCusNo
0077                 fetch first 1 row only
0078                 with CS
0079                 use currently committed;
0080       /end-free
0081      P GetCustInf      E