RPG-free Utilities: http://www.jcrcmds.com/jcrdown2.html * Entire program can now be in free form - except I and O specs * No longer any need for /Free or /End-Free * Just leave columns 6 and 7 blank * Files (dcl-f) can be mixed in with D-specs (no longer have to be first)\\ * /Free and /End-Free no longer required \\ * /Copy and other compiler directives no longer need to start in col 7 \\ * New free form options for: * H-specs (CTL-OPT) * F-specs (DCL-F) * D-specs (DCL-xx) * Where xx = C, DS, PARM**, PI, PR, S, or SUBF** * (**) These are rarely going to be used * P-specs (DCL-PROC) All of the new declaration op-codes follow this basic format: * First the DCL-xx itself * Next the name of the item * File, field, procedure, etc. * Followed by keywords related to other fixed form elements * e.g. File usage, field type and length * Then keywords from the old spec ------------------------------------------------------------------------------- ====== $[hdcolor $\yellow$\$]Best Practices $[/hdcolor$]====== ==== $[hdcolor $\yellow$\$]BIFs $[/hdcolor$]==== /*********** BIFs ************/ * V7 now supports %SCANRPL to scan (search) and replace in one step * %SCANRPL( scanFor : replaceWith : target { : scan start { : scan length } ) ==== $[hdcolor $\yellow$\$]/Copy source code $[/hdcolor$]==== /*********** /Copy source code ************/ * Use the /Include command instead * Copying from a source file limits the member names to 10 characters * Instead, store the code in the IFS * /include '/myApp/proto_utility/userSpaceAPIs.rpgle' ==== $[hdcolor $\yellow$\$]Data Structures $[/hdcolor$]==== /*********** Data Structures ************/ * Instead of compile-time arrays (where the data is at the end of the pgm), use an initialized DS * Consider using qualified data structures for all I/O * DS can now be sorted (see code samples) * %LOOKUP can now also search DS arrays ==== $[hdcolor $\yellow$\$]Gotcha's to watch out for $[/hdcolor$]==== /*********** Gotcha's to watch out for ************/ OVERLAY keyword cannot be used against DS name * Use POS(n) instead Names in EXTNAME, EXTFLD, and DTAARA * Must be in quotes and are case sensitive * Without quotes, they are treated as a variable or constant name Ellipsis (...) for continuation only allowed when continuing a name * But not really needed anymore anyway On F-Spec "U" enables update and delete * In free form *DELETE must be requested explicitly End-DS, End-PR, End-PI are always required * But may appear on same line as DCL-xx in some cases RDi's "Convert all to Free-Form" means only convert "all logic" * And will still generate /Free and /End-Free I and O specs remain in fixed form * Probably forever ==== $[hdcolor $\yellow$\$]Naming $[/hdcolor$]==== /*********** Naming ************/ * use CamelCase * camelCase format is also OK * if you use underscores in sub and proc names, then salary = calculatePay(97); is clearly different from salary = calculate_Pay(97); * Is the first one calling a sub and passing 97? * Or is it assigning the 97th element of an array to **salary**? * If you always use underscores in sub names, the usage will always be clear * use UPPERCASE for named constants * use underscores to separate words * ERR_RECORD_LOCKED * global variables should rarely be used * but if you must use them, prefix them with g_ ==== $[hdcolor $\yellow$\$]Prototypes $[/hdcolor$]==== /*********** Prototypes ************/ * All prototypes should be coded in copy members and include required programs and modules. * A prototype should never be coded in more than one source member * EXTPGM keyword can be omitted * Providing that the program is non-ILE i.e. DFTACTGRP(*YES) * Program name can be omitted from EXTPGM * If the program name is the same as the prototype * EXTPGM('PROGNAME') * Parameter only needed when proto name is different from actual program name dcl-pr MyProgram; // Used to call 'MYPROGRAM' from non-ILE program dcl-pr MyProgram ExtPgm; // Calls 'MYPROGRAM' from any program dcl-pr DifferentName Extpgm('MYPROGRAM'); // Call MYPROGRAM using the name DifferentName ==== $[hdcolor $\yellow$\$]SQL $[/hdcolor$]==== /*********** SQL ************/ * Run SQL Scripts in IBM i Access Clients Solutions has an SQL formatter * Keep SQL statements as simple as possible. You do not want to debug a complex SQL statement in an RPG program. Create a view that “hides” the complexity of joins and casting and select from that view in the RPG program. * Use SET OPTIONS to ensure that the SQL environment is specified correctly at compile time ==== $[hdcolor $\yellow$\$]Strings $[/hdcolor$]==== /*********** Strings ************/ IBM recommends VARCHAR strings (for work fields) rather than fixed-length strings * One obvious advantage is that there is no need to use %TRIM() ==== $[hdcolor $\yellow$\$]Subprocedures $[/hdcolor$]==== /*********** Subprocedures ************/ * s/b designed to perform one task (such as calculate_Pay() or get_customerData()) * The subprocedure can call other subprocedures to achieve that task * can be internal or external (svc pgm or another bound module) * s/b stand-alone * local variables * all needed values s/b passed as parms dcl-proc DayOfWeek Export; dcl-pi *N Int(3) ExtProc(*DclCase); // Omit name - use *N placeholder InputDate Date(*USA) Value; end-pi; dcl-s DayNumber int(3); // Do calcs leaving value in DayNumber Return DayNumber; end-proc DayOfWeek; The biggest advantage of the new support is that you no longer have to flip in and out of fixed and free modes when coding subprocedures. No more /End-Free, P-specs, D-Specs, /Free, logic, /End-Free etc. ==== $[hdcolor $\yellow$\$]Subroutines $[/hdcolor$]==== /*********** Subroutines ************/ Subroutines should not be used for modularization/structure. Use subprocedures instead. But subroutines can be useful for organizing the logic in a subprocedure. ------------------------------------------------------------------------------- ===== $[hdcolor $\yellow$\$]Constants $[/hdcolor$]===== In V7, constants can be used in many more places * Including field length, decimal places, array dimensions - just about anywhere you would use a literal dcl-c Digits 7; dcl-c Decimals 2; // note how the subfield size is defined using constants dcl-ds CustomerInfo; CustomerName VarChar(50); CustomerBalance Packed( Digits: Decimals); end-ds; In older versions, quote characters were assumed (since literals were not allowed) D myDataArea ds DtaAra(JonsData) In RPG-free, this assumes that JonsData is a constant Dcl-Ds myDataArea DtaAra(JonsData); To point to an external data area, use both UPPERCASE and Quotes Dcl-Ds myDataArea DtaAra('JONSDATA'); ------------------------------------------------------------------------------- ===== $[hdcolor $\yellow$\$]Data Structures $[/hdcolor$]===== See also the DS sample in the Code Samples section You can use the LIKEREC keyword to define qualified data structures based on input/output records for an external described file. ===== $[hdcolor $\yellow$\$]Data Declarations (the new D-Specs) $[/hdcolor$]===== /*********** Data Declarations (the new D-Specs) ************/ D-specs (DCL-xx) * Where xx = C, DS, PI, PR or S *xx = DS for Data structures * In most cases there must also be a matching END-DS *xx = SUBF for DS subfields - Very Rarely Required * Code only if field name is a valid free-form op-code * Yes some strange people do use names like READ or SELECT as field names *xx = S for Stand-Alone fields *xx = C for Named Constants Constants // without the optional CONST keyword DCL‑C lower_bound ‑50; DCL‑C max_count 200; DCL‑C start_letter 'A'; // with the optional CONST keyword DCL‑C upper_bound CONST(‑50); DCL‑C min_count CONST(200); DCL‑C end_letter CONST('A'); Data structure dcl-ds Address Dim(20) Qualified; Street1 char(30); City char(30); State char(2); Zip zoned(5); // Zero decimals assumed ZipPlus zoned(4:0); end-ds Address; // DS name @ end is optional Externally-defined DS dcl-ds product Ext end-ds; // to define on one line, just add end-ds; Like keyword // Define using the LIKE keyword DCL‑S cust_index LIKE(index); //Specify length adjustment with LIKE keyword DCL‑S big_index LIKE(index : +6); Zero decimal is the default Dcl-S packedNum Packed(7:2); Dcl-S zonedNum Zoned(7:2); Dcl-S integer Int(10); Dcl-S unsigned Uns(10); Dcl-S float Float(8); Dcl-S character Char(20); Dcl-S varyingChar Varchar(20); Dcl-S dateMDY Date(*MDY); Dcl-S timeUSA Time(*USA); Dcl-S indicator Ind; Dcl-S nastybinary Bindec(9); ===== $[hdcolor $\yellow$\$]File Declarations (the new F-Specs) $[/hdcolor$]===== /*********** F-Specs ************/ File Name listed first - followed by device type keyword (if any) * Device type defaults to DISK - i.e., a Database table * Device type can be omitted if using an externally described Disk file Externally described is the default * File Keyword *EXT can optionally be specified as a parameter Program described files must specify their record length * e.g. PRINTER(132) for a program described printer file Defaults for USAGE are based on device type - more in a moment * *Input, *Output, *Update (implies *Input), *Delete (implies *Update) Add KEYED keyword for keyed database (disk) files\\ File name no longer limited to 10 characters * So meaningful file names can be used * EXTDESC must be used to specify actual name when different from file name Usage defaults are based on device type * Usage(*Input) for DISK * Usage(*Output) for PRINTER * Usage(*Input : *Output) for WORKSTN FCUSTMR0 UF A E K DISK USROPN FREPORT O E PRINTER OFLIND(*IN96) FSCREEN CF E WORKSTN Dcl-F CUSTMR0 DISK Usage(*Update:*Delete:*Output) Keyed UsrOpn; Dcl-F REPORT PRINTER(*EXT) OFLIND(*IN96); Dcl-F SCREEN WORKSTN Usage(*Input:*Output); Note that some of the above parms are not needed because they are defaults (such as Usage(*Input:*Output); for the WORKSTN) Samples that allow (i.e., don't redefine) the defaults DCL-F InvoiceMaster ExtDesc('INVMAST'); // Defaults to Input Disk DCL-F CustMaster Usage(*Update) Keyed; // Keyed Disk file DCL-F qPrint Printer(132) OflInd(PageFull); // Program described DCL-F MyDisplay WorkStn; // Workstation Usage(*Input : *Output) ===== $[hdcolor $\yellow$\$]H-spec equivalent (called Control Specs) $[/hdcolor$]===== /*********** H-Specs ************/ Ctl-Opt debug datEdit(*MDY/) option(*srcStmt:*noDebugIO) bndDir('MYAPP'); /if defined(*CRTBNDRPG) Ctl-Opt dftActGrp(*no) actGrp('PGMBND'); /endIf ==== $[hdcolor $\yellow$\$]Op Codes $[/hdcolor$]==== /*********** Op Codes ************/

Operation Codes

The following table shows the free-form syntax for each operation code.
Table 1. Operation Codes in Free-Form Syntax
Code Free-Form Syntax
ACQ1 ACQ{(E)} device-name workstn-file
BEGSR BEGSR subroutine-name
CALLP {CALLP{(EMR)}} name( {parm1{:parm2...}} )
CHAIN CHAIN{(ENHMR)} search-arg file-or-record-name {data-structure}
CLEAR CLEAR {*NOKEY} {*ALL} name
CLOSE CLOSE{(E)} file-name
COMMIT COMMIT{(E)} {boundary}
DEALLOC 1 DEALLOC{(EN)} pointer-name
DELETE DELETE{(EHMR)} {search-arg} file-or-record-name
DOU DOU{(MR)} indicator-expression
DOW DOW{(MR)} indicator-expression
DSPLY DSPLY{(E)} {message {message-queue {response}}}
DUMP1 DUMP{(A)} {identifier}
ELSE ELSE
ELSEIF ELSEIF{(MR)} indicator-expression
ENDDO ENDDO
ENDFOR ENDFOR
ENDIF ENDIF
ENDMON ENDMON
ENDSL ENDSL
ENDSR ENDSR {return-point}
EVAL {EVAL{(HMR)}} result = expression
EVALR EVALR{(MR)} result = expression
EVAL-CORR EVAL-CORR{(EH)} target-ds = source-ds
EXCEPT EXCEPT {except-name}
EXFMT EXFMT{(E)} format-name {data-structure}
EXSR EXSR subroutine-name
FEOD FEOD{(EN)} file-name
FOR FOR{(MR)} index {= start} {BY increment} {TO|DOWNTO limit}
FORCE FORCE file-name
IF IF{(MR)} indicator-expression
IN 1 IN{(E)} {*LOCK} data-area-name
ITER ITER
LEAVE LEAVE
LEAVESR LEAVESR
MONITOR MONITOR
NEXT1 NEXT{(E)} program-device file-name
ON-ERROR ON-ERROR {exception-id1 {:exception-id2…}}
Start of changeON-EXITEnd of change Start of changeON-EXIT {status}End of change
OPEN OPEN{(E)} file-name
OTHER OTHER
OUT1 OUT{(E)} {*LOCK} data-area-name
POST 1 POST{(E)} {program-device} file-name
READ READ{(EN)} file-or-record-name {data-structure}
READC READC{(E)} record-name {data-structure}
READE READE{(ENHMR)} search-arg|*KEY file-or-record-name {data-structure}
READP READP{(EN)} name {data-structure}
READPE READPE{(ENHMR)} search-arg|*KEY file-or-record-name {data-structure}
REL 1 REL{(E)} program-device file-name
RESET 1 RESET{(E)} {*NOKEY} {*ALL} name
RETURN RETURN{(HMR)} expression
ROLBK ROLBK{(E)}
SELECT SELECT
SETGT SETGT{(EHMR)} search-arg file-or-record-name
SETLL SETLL{(EHMR)} search-arg file-or-record-name
SORTA SORTA{(AD)} array-name or keyed-ds-array
TEST 1 TEST{(EDTZ)} {dtz-format} field-name
UNLOCK 1 UNLOCK{(E)} name
UPDATE UPDATE{(E)} file-or-record-name {data-structure|%FIELDS(name{:name...})}
WHEN WHEN{(MR)} indicator-expression
WRITE WRITE{(E)} file-or-record-name {data-structure}
XML-INTO XML-INTO{(EH)} target-or-handler xml-document
XML-SAX XML-SAX{(E)} handler xml-document
Note:
  1. Complex-qualified names are not allowed for this operation code.

The next table is a summary of the specifications for each operation code in traditional syntax.

Table 2. Operation Codes in Traditional Syntax
Codes Factor 1 Factor 2 Result Field Resulting Indicators
71-72 73-74 75-76
ACQ (E7) device-name workstn-file ER
ADD (H) Addend Addend Sum + - Z
ADDDUR (E) Date/Time Duration:Duration Code Date/Time ER
ALLOC (E) Length Pointer ER
ANDxx Comparand Comparand
BEGSR subroutine-name
BITOFF Bit numbers Character field
BITON Bit numbers Character field
CABxx Comparand Comparand Label HI LO EQ
CALL (E) Program name Plist name ER LR
CALLB (D E) Procedure name or Procedure pointer Plist name ER LR
CALLP (E M/R) name{ (parm1 {:parm2…}) }
CASxx Comparand Comparand Subroutine name HI LO EQ
CAT (P) Source string 1 Source string 2:number of blanks Target string
CHAIN (E N) search-arg name (file or record format) data-structure NR2 ER
CHECK (E) Comparator String Base String:start Left-most Position(s) ER FD2
CHECKR (E) Comparator String Base String:start Right-most Position(s) ER FD2
CLEAR *NOKEY *ALL name (variable or record format)
CLOSE (E) file-name or *ALL ER
COMMIT (E) boundary ER
COMP1 Comparand Comparand HI LO EQ
DEALLOC (E/N) pointer-name ER
DEFINE *LIKE Referenced field Defined field
DEFINE *DTAARA External data area Internal field
DELETE (E) search-arg name (file or record format) NR2 ER
DIV (H) Dividend Divisor Quotient + - Z
DO Starting value Limit value Index value
DOU (M/R) indicator-expression
DOUxx Comparand Comparand
DOW (M/R) indicator-expression
DOWxx Comparand Comparand
DSPLY (E)4 message message-queue response ER
DUMP (A) identifier
ELSE
ELSEIF (M/R) indicator-expression
END Increment value
ENDCS
ENDDO Increment value
ENDFOR
ENDIF
ENDMON
ENDSL
ENDSR label return-point
EVAL (H M/R) Result = Expression
EVALR (M/R) Result = Expression
EVAL-CORR EVAL-CORR target-ds = source-ds
EXCEPT except-name
EXFMT (E) Record format-name data-structure ER
EXSR subroutine-name
EXTRCT (E) Date/Time:Duration Code Target Field ER
FEOD (EN) file-name ER
FOR Index-name = start-value BY increment TO|DOWNTO limit
FORCE file-name
GOTO Label
IF (M/R) indicator-expression
IFxx Comparand Comparand
IN (E) *LOCK data-area-name ER
ITER
KFLD Key field
KLIST KLIST name
LEAVE
LEAVESR
LOOKUP1 (array) Search argument Array name HI LO EQ6
LOOKUP1 (table) Search argument Table name Table name HI LO EQ6
MHHZO Source field Target field
MHLZO Source field Target field
MLHZO Source field Target field
MLLZO Source field Target field
MONITOR
MOVE (P) Data Attributes Source field Target field + - ZB
MOVEA (P) Source Target + - ZB
MOVEL (P) Data Attributes Source field Target field + - ZB
MULT (H) Multiplicand Multiplier Product + - Z
MVR Remainder + - Z
NEXT (E) program-device file-name ER
OCCUR (E) Occurrence value Data structure Occurrence value ER
ON-ERROR Status codes
Start of changeON-EXITEnd of change Start of change End of change Start of changeStatusEnd of change
OPEN (E) file-name ER
ORxx Comparand Comparand
OTHER
OUT (E) *LOCK data-area-name ER
PARM Target field Source field Parameter
PLIST PLIST name
POST (E)3 program-device file-name INFDS name ER
READ (E N) name (file or record format)

data-
structure

 ER EOF5
READC (E) record-name

data-
structure

 ER EOF5
READE (E N) search-arg name (file or record format)

data-
structure

 ER EOF5
READP (E N) name (file or record format)

data-
structure

 ER BOF5
READPE (E N) search-arg name (file or record format)

data-
structure

 ER BOF5
REALLOC (E) Length Pointer ER
REL (E) program-device file-name ER
RESET (E) *NOKEY *ALL name (variable or record format) ER
RETURN (H M/R) Expression
ROLBK (E) ER
SCAN (E) Comparator string:length Base string:start Left-most position(s) ER FD2
SELECT
SETGT (E) search-arg name (file or record format) NR2 ER
SETLL (E) search-arg name (file or record format) NR2 ER EQ6
SETOFF1 OF OF OF
SETON1 ON ON ON
SHTDN ON
SORTA (A/D) array-name or keyed-ds-array
SQRT (H) Value Root
SUB (H) Minuend Subtrahend Difference + - Z
SUBDUR (E) (duration) Date/Time/ Timestamp Date/Time/Timestamp Duration: Duration Code ER
SUBDUR (E) (new date) Date/Time/ Timestamp Duration:Duration Code Date/Time/ Timestamp ER
SUBST (E P) Length to extract Base string:start Target string ER
TAG Label
TEST (E)8 Date/Time or Timestamp Field ER
TEST (D E)8 Date Format Character or Numeric field ER
TEST (E T)8 Time Format Character or Numeric field ER
TEST (E Z)8 Timestamp Format Character or Numeric field ER
TESTB1 Bit numbers Character field OF ON EQ
TESTN1 Character field NU BN BL
TESTZ1 Character field AI JR XX
TIME Target field
UNLOCK (E) name (file or data area) ER
UPDATE (E) name (file or record format)

data-
structure

 ER
WHEN (M/R) indicator-expression
WHENxx Comparand Comparand
WRITE (E) name (file or record format)

data-
structure

 ER EOF5
XFOOT (H) Array name Sum + - Z
XLATE (E P) From:To String:start Target String ER
XML-INTO XML-INTO target-or-handler xml-document
XML-SAX XML-SAX{(E)} handler xml-document
Z-ADD (H) Addend Sum + - Z
Z-SUB (H) Subtrahend Difference + - Z
Note:
  1. At least one resulting indicator is required.
  2. The %FOUND built-in function can be used as an alternative to specifying an NR or FD resulting indicator.
  3. You must specify factor 2 or the result field. You may specify both.
  4. You must specify factor 1 or the result field. You may specify both.
  5. The %EOF built-in function can be used as an alternative to specifying an EOF or BOF resulting indicator.
  6. The %EQUAL built-in function can be used to test the SETLL and LOOKUP operations.
  7. For all operation codes with extender 'E', either the extender 'E' or an ER error indicator can be specified, but not both.
  8. You must specify the extender 'E' or an error indicator for the TEST operation.
===== $[hdcolor $\yellow$\$]Templates $[/hdcolor$]===== /*********** Templates ************/ Templates are fields and data structures that can only be used/referenced via LIKE and LIKEDS dcl-Ds baseAddress template qualified; street1 char(30); street2 char(30); city varchar(20); state char(2) inz('MN'); zip char(5); zipplus char(4); end-Ds; dcl-Ds mailAddress likeds(baseAddress) inz(*likeDS); ===== $[hdcolor $\yellow$\$]Code Samples $[/hdcolor$]===== /*********** Code Samples ************/ Complete RPG-free program ctl-opt option(*srcstmt) dftactgrp(*No); dcl-ds employeeDS; // Nice to be able to have comments here! firstName char(16) Inz('James'); lastname char(30) Inz('Joyce'); salary packed(7:2) Inz(12500); end-ds; // Define printer file and associated DS dcl-f qprint printer(80); // This printer is program described dcl-ds prtDs len(80) end-ds; dsply ('Hello to our new employee'); dsply ( %TrimR(firstName) + ' ' + lastName ); prtDs = 'The name of our new employee is ' + %TrimR(firstName) + ' ' + %TrimR(lastName) + ' his salary is $' + %Char(salary); write qprint prtds; ==== $[hdcolor $\yellow$\$]Data Structure $[/hdcolor$]==== /*********** Data Structure ************/ dcl-Ds APIError qualified; bytesprovided int(10) inz(%size(APIError)); bytesavail int(10) inz(0); msgid char(7); *N char(1); msgdata char(240); end-Ds; %LOOKUP can now also search DS arrays element = %LookUp( 'A123C': productInfo(*).productCode); DS to remap numeric indicators dcl-F Mod30101D workstn(*ext) usage(*input:*output) IndDs(WSI); dcl-Ds WSI qualified; F3Exit ind pos(3); F5Refresh ind pos(5); F12Cancel ind pos(12); F23Delete ind pos(23); pageDown ind pos(26); pageUp ind pos(27); errorInds char(10) pos(31); enableDelete ind pos(41); SFLInds char(3) pos(51); SFLDsp ind pos(51); SFLDspCtl ind pos(52); SFLClr ind pos(53); SFLNxtChg ind pos(54); SFLPageDown ind pos(55); SFLPageUp ind pos(56); SFLProtect ind pos(57); enableMsgSFL ind pos(91) inz(*on); end-Ds; Instead of compile-time arrays (where the data is at the end of the pgm), use an initialized DS dcl-Ds allMonths; *N char(9) inz('January'); // *N = unnamed field *N char(9) inz('February'); *N char(9) inz('March'); *N char(9) inz('April'); *N char(9) inz('May'); *N char(9) inz('June'); *N char(9) inz('July'); *N char(9) inz('August'); *N char(9) inz('September'); *N char(9) inz('October'); *N char(9) inz('November'); *N char(9) inz('December'); monthNames char(9) dim(12) pos(1); end-Ds; ==== $[hdcolor $\yellow$\$]Sort a DS $[/hdcolor$]==== /*********** Sort a DS ************/ The (*) is the array being sorted. Doesn't mean much for a single DS, but you can sort nested arrays! For i = 1 to %elem(products2); SortA products2(i).salesByMonth(*).sales; EndFor; dcl-Ds products1 Dim(999) Qualified productCode char(5) description varchar(30) totalSales packed(9:2) qtyInStock packed(5:0) end-Ds SortA products1(*).totalSales; SortA products1(*).description; SortA(A) products1(*).totalSales; // Sort ascending sequence SortA(D) products1(*).description; // Sort descending sequence ==== $[hdcolor $\yellow$\$]Loop through a file $[/hdcolor$]==== /*********** Loop through a file ************/ /free setll k#plp50 plpyitms; reade k#plp50 plpyitms; dow NOT %eof(plpyitms); chain k#plp15 plunitms; if %found(plunitms); exsr $date; exsr $datep; eval supn = supn15; eval sref = sref15; eval usert1 = 'Payment Run id#'; eval usert2 = 'Payment Reference #'; eval usert3 = 'Invoice #'; eval user1 = #pyrna; eval user2 = pref50; eval user3 = lref50; eval btmt = %editc(bpmt50:'L'); eval usert4 = 'Payment Run Date'; eval user4 = docdp; eval usert5 = 'System Identifier'; eval user5 = 'JBA'; write apccoutr; endif; reade k#plp50 plpyitms; enddo; /end-free ==== $[hdcolor $\yellow$\$]Monitor for (and ignore) an error $[/hdcolor$]==== /*********** Monitor ************/ /free monitor; p#cono = 'D1'; today_date = %editc(%dec(%date():*cymd) : 'X'); p#fdat = %dec(today_date:7:0); /end-free ==== $[hdcolor $\yellow$\$]SQL Sample $[/hdcolor$]==== /*********** SQL ************/ EXEC SQL SELECT * INTO :Pmp02Rec FROM PMP02 WHERE ORDN02=SUBSTRING(:Lda,349,7) AND DTLC02=9999999; IF SqlCod=0; // go to next step when po's found ELSEIF SqlCod=100; // if po's not found this is (probably) interactive - use LDA values Vndr02=%SUBST(Lda:257:6); Whse02=%SUBST(Lda:368:2); ELSE; RETURN; ENDIF; ==== $[hdcolor $\yellow$\$]Sample leave/iter $[/hdcolor$]==== /*********** Leave/Iter ************/ /free Chain (cono:cusn:dseq:catn) OEP70M17; dow %Found(OEP70M17); if lqty70 > 0; eval(h) price3 = LVAL70/LQTY70; eval lprc = price3; leave; else; reade (cono:cusn:dseq:catn) OEP70M17; iter; endif; enddo; /end-free ==== $[hdcolor $\yellow$\$]Sample Run a CL command inside RPG $[/hdcolor$]==== /*********** Run a CL inside RPG ************/ D Msg PR EXTPGM('MSGWDWR') D Line1 50A CONST D Line1 50A CONST D Qcmdexc PR EXTPGM('QCMDEXC') D Cmd 500A OPTIONS(*VARSIZE) CONST D CmdLen 15P 5 CONST /free Cmd='ADDLIBLE EDIUK *LAST'; CALLP(E) QCMDEXC(%TRIMR(Cmd):%LEN(%TRIMR(Cmd))); /end-free