Warning, /frameworks/syntax-highlighting/autotests/input/qrpg.test is written in an unsupported language. File is not indexed.
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