IBM RPG - Example Code

Example Code

The following program receives a customer number as an input parameter and returns the name and address as output parameters.

* Historically RPG is columnar in nature, though free-formatting * is allowed under particular circumstances. * The purpose of various lines code are determined by a * letter code in column 6. * An asterisk (*) in column 7 denotes a comment line * "F" (file) specs define files and other i/o devices F ARMstF1 IF E K Disk Rename(ARMST:RARMST) * "D" specs are used to define variables D pCusNo S 6p 0 D pName S 30a D pAddr1 S 30a D pAddr2 S 30a D pCity S 25a D pState S 2a D pZip S 10a * "C" (calculation) specs are used for executable statements * Parameters are defined using plist and parm opcodes C *entry plist C parm pCusNo C parm pName C parm pAddr1 C parm pAddr2 C parm pCity C parm pState C parm pZip * The "chain" command is used for random access of a keyed file C pCusNo chain ARMstF1 * If a record is found, move fields from the file into parameters C if %found C eval pName = ARNm01 C eval pAddr1 = ARAd01 C eval pAddr2 = ARAd02 C eval pCity = ARCy01 C eval pState = ARSt01 C eval pZip = ARZp15 C endif * RPG makes use of switches. One switch "LR" originally stood for "last record" * LR actually flags the program and its dataspace as removable from memory. C eval *InLR = *On

The same program using free calculations:

* "F" (file) specs define files and other i/o devices FARMstF1 IF E K Disk Rename(ARMST:RARMST) * "D" specs are used to define variables and parameters * The "prototype" for the program is in a separate file * allowing other programs to call it /copy cust_pr * The "procedure interface" describes the *ENTRY parameters D getCustInf PI D pCusNo 6p 0 const D pName 30a D pAddr1 30a D pAddr2 30a D pCity 25a D pState 2a D pZip 10a /free // The "chain" command is used for random access of a keyed file chain pCusNo ARMstF1; // If a record is found, move fields from the file into parameters if %found; pName = ARNm01; pAddr1 = ARAd01; pAddr2 = ARAd02; pCity = ARCy01; pState = ARSt01; pZip = ARZp15; endif; // RPG makes use of switches. One switch "LR" originally stood for "last record" // LR actually flags the program and its dataspace as removable from memory. *InLR = *On; /end-free

Assume the ARMSTF1 example table was created using the following SQL Statement:

create table armstf1 (arcnum decimal(7,0), arname char(30), aradd1 char(30), aradd2 char(30), arcity char(25), arstte char(2), arzip char(10))

The same program using free calculations and embedded SQL:

* RPG IV no longer requires the use of the *INLR indicator to terminate a program. * by using the MAIN keyword on the "H" (Header) spec, and identifying the "main" or * entry procedure name, the program will begin and end normally without using the * decades-old RPG Cycle and instead a more "C like" begin and end logic. H MAIN(getCustInf) * "D" specs are used to define variables and parameters * The "prototype" for the program is in a separate file * allowing other programs to call it /copy cust_pr * The "procedure interface" describes the *ENTRY parameters P getCustInf B D getCustInf PI D pCusNo 6p 0 const D pName 30a D pAddr1 30a D pAddr2 30a D pCity 25a D pState 2a D pZip 10a /free exec sql select arName, arAddr1, arAdd2, arCity, arStte, arZip into :pName, :pAddr1, :pAddr2, :pCity, :pState, :pZip from ARMstF1 where arCNum = :pCusNo for fetch only fetch first 1 row only optimize for 1 row with CS; /end-free P GetCustInf E

As of V7R1 of the operating system, the above program would not necessarily need the prototype in a separate file, so it could be completely written as:

H main(GetCustInf) D ARMSTF1 E DS P GetCustInf B D GetCustInf PI extpgm('CUS001') D inCusNo like(arCNum) const D outName like(arName) D outAddr1 like(arAdd1) D outAddr2 like(arAdd2) D outCity like(arCity) D outState like(arStte) D outZip like(arZip) /free exec sql select arName, arAdd1, arAdd2, arCity, arStte, arZip into :outName, :outAddr1, :outAddr2, :outCity, :outState, :outZip from ARMSTF1 where arCNum = :inCusNo fetch first 1 row only with CS use currently committed; /end-free P GetCustInf E