• V7 now supports %SCANRPL to scan (search) and replace in one step
  • %SCANRPL( scanFor : replaceWith : target { : scan start { : scan length } )

• 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'

• 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

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

• use CamelCase
  • camelCase format is also OK
• if you use underscores in sub and proc names, then

salary = calculatePay(97);

  is clearly different from 
  <code java>salary = calculate_Pay(97);</code>
  * 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_

• 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

• 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

IBM recommends VARCHAR strings (for work fields) rather than fixed-length strings

• One obvious advantage is that there is no need to use %TRIM()

• 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.

Subroutines should not be used for modularization/structure. Use subprocedures instead. But subroutines can be useful for organizing the logic in a subprocedure.

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'); 

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.

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);

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)

 Ctl-Opt debug datEdit(*MDY/) option(*srcStmt:*noDebugIO) bndDir('MYAPP');
 
 /if defined(*CRTBNDRPG)
   Ctl-Opt dftActGrp(*no) actGrp('PGMBND');
 /endIf

Operation Codes

The following table shows the free-form syntax for each operation code.

• Extenders

  (A)

  Always perform a dump, even if DEBUG(*NO) is specified

  (A)

  Sort ascending

  (D)

  Pass operational descriptors on bound call

  (D)

  Date field

  (D)

  Sort descending

  (E)

  Error handling

  (H)

  Half adjust (round the numeric result)

  (M)

  Default precision rules

  (N)

  Do not lock record

  (N)

  Set pointer to *NULL after successful DEALLOC

  (N)

  Do not force data to non-volatile storage

  (P)

  Pad the result with blanks or zeros

  (R)

  "Result Decimal Position" precision rules

  (T)

  Time field

  (Z)

  Timestamp field

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…}}
ON-EXIT	ON-EXIT {status}
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.

• An empty column indicates that the field must be blank.
• All underlined fields are required.
• An underscored space denotes that there is no resulting indicator in that position.
• Symbols

  +

  Plus

  -

  Minus

• Extenders

  (A)

  Always perform a dump, even if DEBUG(*NO) is specified

  (A)

  Sort ascending

  (D)

  Pass operational descriptors on bound call

  (D)

  Date field

  (D)

  Sort descending

  (E)

  Error handling

  (H)

  Half adjust (round the numeric result)

  (M)

  Default precision rules

  (N)

  Do not lock record

  (N)

  Set pointer to *NULL after successful DEALLOC

  (P)

  Pad the result with blanks or zeros

  (R)

  "Result Decimal Position" precision rules

  (T)

  Time field

  (Z)

  Timestamp field

• Resulting indicator symbols

  BL

  Blank(s)

  BN

  Blank(s) then numeric

  BOF

  Beginning of the file

  EOF

  End of the file

  EQ

  Equal

  ER

  Error

  FD

  Found

  HI

  Greater than

  IN

  Indicator

  LO

  Less than

  LR

  Last record

  NR

  No record was found

  NU

  Numeric

  OF

  Off

  ON

  On

  Z

  Zero

  ZB

  Zero or Blank

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
ON-EXIT		Status
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: At least one resulting indicator is required. The %FOUND built-in function can be used as an alternative to specifying an NR or FD resulting indicator. You must specify factor 2 or the result field. You may specify both. You must specify factor 1 or the result field. You may specify both. The %EOF built-in function can be used as an alternative to specifying an EOF or BOF resulting indicator. The %EQUAL built-in function can be used to test the SETLL and LOOKUP operations. For all operation codes with extender 'E', either the extender 'E' or an ER error indicator can be specified, but not both. You must specify the extender 'E' or an error indicator for the TEST operation.

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);

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;

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; 

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 

/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 =;
			eval sref =;
			eval usert1 = 'Payment Run id#';
			eval usert2 = 'Payment Reference #';
			eval usert3 = 'Invoice #';
			eval user1 =;
			eval user2 =;
			eval user3 =;
			eval btmt  = %editc(bpmt50:'L');
			eval usert4 = 'Payment Run Date';
			eval user4 =;
			eval usert5 = 'System Identifier';
			eval user5 = 'JBA';
 
			write apccoutr;
 
		endif;
 
 
		reade k#plp50 plpyitms;
	enddo;
 
/end-free
 

/free
	monitor;
	p#cono = 'D1';
	today_date = %editc(%dec(%date():*cymd) : 'X');
	p#fdat = %dec(today_date:7:0);
/end-free

       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;

/free
	Chain (cono:cusn:dseq:catn) OEP70M17;
	dow %Found(OEP70M17);
		if lqty70 > 0;
			eval(h) price3 =/;
			eval lprc   =;
			leave;
		else;
			reade (cono:cusn:dseq:catn) OEP70M17;
			iter;
		endif;
	enddo;
 
/end-free

	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