blog:iseries:rpg_free

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$]

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

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

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
Enter your comment. Wiki syntax is allowed:
Y G S U​ B
 
  • blog/iseries/rpg_free.txt
  • Last modified: 2020/03/06 12:25
  • (external edit)