blog:iseries:rpg

rpg_free

Misc tips/reminders

  • Concatenate with +
  • free-form supports +=
  • RTVQMQRY
  • RTVQMFORM
  • Check system files in QSYS2 lib
    • SYSCST (constraints)
    • SYSINDEXES
    • SYSKEYS (key fields for indexes)
    • SYSTABLES
    • SYSTYPES (UDTs)

ILE

  • compile modules with CrtRpgMod
  • use CrtPgm to bind modules into a callable program
  • can use CrtBndRPG to do both steps (creates a temp *Module object), but it may limit the ILE features
  • UPDPGM can update (re-attach) a module to the main object
  • CVTRPGSRC converts RPGIII code to RPGIV



There are three types of arrays:

  • The _run-time array_ is loaded by your program while it is running.
  • The _compile-time array_ is loaded when your program is created. The initial data becomes a permanent part of your program.
  • The _prerun-time array_ is loaded from an array file when your program begins running, before any input, calculation, or output operations are processed.

This will Z-ADD 15 to every element of ARRAY

C                 Z-ADD15 ARRAY

Each element of ARRAY1 will be added to the corresponding element of ARRAY2

C                    ADD ARRAY1 ARRAY2

%Abs

absolute value

%Char

converts to character
%CHAR(date : *iso)

%Check(look_for: string_to_search)

first position in string_to_search that is not a value in look_for

%Date(optional_date: optional_date_format)

if no date supplied, then get current date

%Days

number of days as a duration

%Dec

convert to packed number

%Dech

convert to packed number (half-adjusted)

%DecPos

# of decimal digits

%Diff

diff between 2 dates/times

%Div

divide 2 numbers
DIV = %DIV(A:B);   (divide A by B)

%Editc(Number: 'X': *CURSYM)

edit code (numeric)
  • Common codes (the X, above, or used in O specs)
  • 1-4 have no negative sign
  • 5-9 are user-defined @ system level
  • A-D use CR for negative values
  • J is most common (commas, dec separator, - for neg, shows zeros)
  • K (commas, dec separator, - for neg, zeros suppressed)
  • Y - for dates
Edit Code DescriptionNo SignCR Sign-Sign (R)-Sign (L)
Commas and zero balances1AJN
Commas2BKO
Zero balances3CLP
No commas or zero balances4DMQ
User-defined edit codes5-9
Date edit (4 digits)W
Date editY
Suppress leading zerosZ

%Editw

edit word
  • first zero ends zero-suppression (leading zeros after that position are printed)
  • first asterisk also ends zero-suppression, but causes leading asterisks in the ouput
    • 'b*bbbbbb.bb' (each b is a blank/space character) applied to 12345 prints ***123.45
  • a currency symbol followed by a zero floats
    • 'bb,bbb,b$0.bb' applied to 12 prints $.12
  • a leading currency symbol always appears in that position
    • '$b,bbb,bb0.bb' applied to 123456 prints $bbb1,234.56
  • an ampersand (&) causes a blank in the output
  • any other character prints that exact character
    • 'bb/bb/bb' aplied to 12345 prints b1/23/45
    • '0bb/bb/bb' aplied to 12345 prints b01/23/45

%Elem

# of elements or occurrences

%EOF(filename)

“1” if EOF

%Equal

“1” if SETLL or LOOKUP found an exact match

%Error

“1” if op code with “E” extender hit an error

%Fields

update record %fields(salary:status);

%Float

converts to float

%Found(optional_filename)

“1” if found (CHAIN, DELETE, SETGT, SETLL), an element (LOOKUP), or a match (CHECK, CHECKR, SCAN)

%Int %Inth

half adjusted integet

%Len %Lookupxx(argument: array{:start index {:number of elements}}

array index of the matching element

%Occur(DS)

active occurrence # of the DS

%Open(filename)

“1” if open

%Parms

# of parms passed into pgm

%Rem

remainder
  REM = %REM(A:B);

%Replace(string: into_string: optional_start: optional_length) %Scan(look_for: look_in: optional_start)

1st position of look_for within look_in

%Size

size of a variable or text string (not length)
    DIM(%SIZE(OTHER_FIELD))
    // Use %size and %substr to extract 3 concatenated fields WITHOUT hard-coding the field sizes
        eval      #cono = %subst($$id:1:%size(#cono))
        eval      #cusn = %subst($$id:%size(#cono)+1:%size(#cusn))
        eval      #dseq = %subst($$id:%size(#cono)+%size(#cusn)+1:%size(#dseq))

%Subdt(date: unit)

“date substring” - portion of a date
    %SUBDT(value:*MSECONDS|*SECONDS|*MINUTES|*HOURS|*DAYS|*MONTHS|*YEARS)
    %SUBDT(value:*MS|*S|*MN|*H|*D|*M|*Y)

%Subst

substring(string:start:length)
    // After the EVAL the original value of A contains ’ab****ghijklmno’
     %SUBST(A(3:4))=****;

%Time %Timestamp %TLookupxx(argument: search table {: alternate table}

“1” if match, “0” otherwise

%Trim %Triml %Trimr %Uns

unsigned number

%XFoot(array)

sum of the elements

%Xlate(Lower:Upper:String)


CAT(P)

optional (P) = pad with blanks (on right side)
CAT FLD1:2 FLD2 - put 2 blanks between FLD1 and FLD2

CHECK CHECKR CLEAR

Only initializes Output or Both fields - NOT Input Only fields

Eval

“normal” eval - same as MOVEL

Eval(R)

forces intermediate numbers to have the same precision as the result

Evalr

eval with right adjust - same as MOVE command

FEOD

Force End of Data (forces an EOF condition)
does not close files

FOR

for i = %len(field) downto 1;
for i = 1 to %len(field);
for i = 1 by 2 to %len(field); (same as STEP 2 in VBA)

GOTO

jump-to points are defined with TAG opcode

Max() Min() SCAN SUBST TIME

if the result file is 6,0, then it returns just HHMMSS
if the result file is 12,0, then it returns hhmmssMMDDYY

TRIM TRIML TRIMR XFOOT

Adds all elements of an array into a result field

Continuation Lines for C-Specs

- each pair below has the same meaning
- in the last example, you could use (-) instead of (+), but then the next line must start in position 1 of the field
C                    eval x = a + b
C                    eval x = a +
C                                    b
 
C                    eval x = 'abc'
C                    eval x = 'ab+
C                                     c'

Continuation for field names use elipses

C                   eval  MyLongF...
C                            ieldName = A + B

That even works on D-Spec names, constants, and literals

  • note that the 'S'tandalone indicator and field size are on the next line
    D QuiteLongFieldNameThatCannotAlwaysFitInOneLine...
    D                  S                    10A
     *
    DNUMERIC   C                              12345
    D                                                    67

C              CALL 'PGM'           BBERLR
C      VAR1 PARM VAR2 PASS1    10
  • the value of VAR2 is placed in PASS1, which is 10A, return value placed in VAR1
  • BB = empty/blank value
  • ER = indicator seton if error in called pgm
  • LR = indicator seton if called pgm seton LR

CALLB(D/E)

used to call bound procedures
(D) include operational descriptors
(E) enables exception handling

CALLP(E M/R)

used to call prototyped procedures or programs

CHAIN(EN)

(E) enables exception handling
(N) do not lock the record
CL0N01Factor1+++++++Opcode(E)+Factor2+++++++Result++++++++Len++D+HiLoEq..
C     KEY           CHAIN     FILE                               NRERBB
  • NR = indicator seton if no record found
  • ER = indicator seton if error in called pgm
  • BB = empty/blank value
DName+++++++++++ETDsFrom+++To/L+++IDc.Keywords+++++++++++++++++++++++++
D custRecKeys     ds                  likerec(custRec : *key)
/free
// custRecKeys is a qualified data structure
        custRecKeys.name =;
        custRecKeys.zip =;
 
        // the *KEY data structure is used as the search argument for CHAIN
        chain %kds(custRecKeys) custRec;
/end-free
 
// Read the record directly into the data structure
chain (’abc’ : ’AB’) custRec custRecDs;

Verifies that all characters in Factor 2 are in Factor 1

  • Factor 2 contains characters to be verified and optional starting position separated by a colon (:)
  • Result field contains position of 1st difference.

If VALID is a constant containing the valid characters, then the following line verifies that FIELD contains only characters from VALID.

  • If X > 0, then the character in X is invalid.
C           VALID CHECKFIELD X

This does the same validation, but it starts checking at position 2.

C           VALID CHECKFIELD:2 X

This finds the first non-blank character in FIELD.

C               ' ' CHECKFIELD X

This finds the LAST non-blank character in FIELD.

C               ' ' CHEKRFIELD X

CLEAR

Clears all fields (resets them to *ZERO, *BLANK or *OFF)

RESET

Resets all fields to the value they had after the *INIT operation (which includes the *INZSR routine, and all D.S. inits ('I' in column 8 of a D.S. subfield.)

For Record Formats, ONLY Output or Both fields are initialized - NOT Input Only fields. Field conditioning indicators are also initialized.


If you need to build a CL command (to use with QCMDEXC) use F13 to change from RPG to CLP. Now you can enter the command, prompt it to get the format, press enter, and select F13 to change back to RPG. Now you have the format for the command, without manually typing each parm.


CL0N01Factor1+++++++Opcode(E)+Factor2+++++++Result++++++++Len++D+HiLoEq..
C               HOURS     COMP 40                               HiLoEq
  • Hi indicator seton if Hours is higher than 40
  • Lo indicator seton if Hours is lower than 40
  • Eq indicator seton if Hours = 40

  1. A record is read
  2. Level testing is performed: LR…L3, L2, L1 - any level will turn on indicators for all lower levels
  3. Control level calculations are performed in sequence: L1, L2…LR. The calculations must be coded in that sequence as well.
  4. Control level totals are printed in sequence: L1, L2 … LR. The output specs must be coded in that sequence as well.
  5. If LR is off, detail calcs and printing are performed
  6. If LR is off, all level indicators are turned off and another record is read.

  • if not using embedded SQL, they have the same meaning
  • when using embedded SQL, the SQL pre-processor does not expand /INCLUDE statements, so don't put SQL commands inside them
  • if no filename specified, uses QRPGLESRC
/COPY libraryname/filename,membername
 
/COPY filename,membername
 
/COPY membername

  • can be externally described (E in col 22)
  • can be PSDS (S in col 23)
  • can be DTAARA (U in col 23)
  • can be Data Structure, Constant, or Standalone field (DS, C or S in col 24-25)
  • Keywords include ALT() {alternating array}, ASCEND/DESCEND, CONST(), DIM(), EXPORT/IMPORT, EXTNAME() {to define fields in a DS}, INZ(), LIKE(), OCCUR() {mult occur DS}, OVERLAY() {to overlap another DS}, PREFIX() {for fields from an external DS}
  • Length values can use +5 to define a 5-char field (just like DDS)

This defines TOTAL as a Data Area

C *NAMVAR DEFN TOTAL

This retrieves the Data Area, but also puts an exclusive lock on it

C *LOCK IN TOTAL

*LOCK is optional

This Updates the Data Area, (the optional *LOCK makes it Not Release the Lock)

C *LOCK OUT TOTAL

*LOCK is optional

* Define Data areas

D TotAmt			s				8p 2 dtaara
D TotGrs			s			  10p 2 dtaara
D TotNet			s			  10p 2 dtaara
 
/free
// Retrieval all 3 data areas
	in *lock  *dtaara;
/end-free

  • U in col 23 defines a data area DS (not a “user” DS)
  • if the DS name is empty (cols 7-21) then the LDA is used
  • S in col 23 defines a PSDS
  • if defined with QUALIFIED keyword, subfields must be defined with DS1.FLD1 (where DS1 is the name of the DS)
  • use LIKE() to duplicate fields, but LIKEDS() to duplicate DS's

To define a D.S. to match an external file:

FCUSTMASTIF E K DISK
 
ICUSTDS E DSCUSTMAST

The DS CUSTDS is now defined with every field in the file CUSTMAST. You could even define CUSTDS to be multiple ocurring!

Typical DS:

I DS
I 1 6 DATE
I 7 12 DATE2

DS Keywords

  • CONST('TEXT') < requires C entry (not 'S'tandalone or blank)
  • DIM(#)
  • DTAARA(*LDA)
  • DTAARA(DTAARA_NAME)
  • EXTNAME(FILE1)
  • EXTFLD(FIELD_FROM_FILE1)
  • INZ('TEXT')
  • INZ(123.5)
  • OCCURS(#)
  • OVERLAY(FIELD)
  • OVERLAY(FIELD:POS)
  • PREFIX(A_)

To view the occurrences of a mult-occur DS, you need to have the Object Definition Table (ODT) number of the occurrence - there are 2 ways to get this:

  1. CRTRPGPGM w/ GENOPT(*LIST *XREF) - within the IRP x-ref section, under the column titled “ODT Name,” find the entry for the mult-occur DS you wish to view - it will be followed by another entry w/ the same name but w/ a suffix of 0 - appearing in front of this entry is a 4-char hex # (the ODT number)
  2. Dump the object using DMPOBJ - scan the listing for the DS - in front of the name of the DS will be a field of the same name w/ a suffix of 0 - in the hex portion on the same line is the ODT (the 1st 4 chars of the 8-char hex #)

Once you have the ODT, use one of these:

ADDBKP 123.00 PGMVAR('/1234')             - the '1234' is the ODT
DSPPGMVAR PGMVAR('/1234') 

  • UDATE is a 6-digit job date
  • *DATE is an 8-digit job date
  • *MDY has separators
  • *MDY0 DOES NOT have separators

Date math uses normal math symbols (date1 + %days(5))


STRDBG

  • F6 - adds/clears a breakpoint
  • F10 - steps
  • F11 - displays a variable
  • F12 - resumes
  • F17 - watch
  • after running STRDBG, you can manually open the debugger with DSPMODSRC
    • can also use SET to set options

If you have a file w/ lots of decimal data errors (especially if you migrated from a S/36), compile the following pgm w/ IGNDECERR(YES):

Ffilename UP E DISK
 
C UPDATRcdFmt

C                MOVE *ZEROS CUSTNO
C                MOVEL CUSTNO STR 256 P           (256 Chars, padded w/ blanks)
 * STR now contains a '0' for each position in CUSTNO
C            '' CHECKR STR LEN 30 (3,0 Decimal)

LEN now contains the length of CUSTNO


C                Z-ADD .999999999 BALNC
C                Z-ADD BALNC DPTST 99 (9,9 Decimal)
C                MOVEL DPTST DPTST@ 10 P (10 Char, padded w/ blanks)
 * DPTST@ now contains a '9' for each decimal position in BALNC
C           '9' CHECK DPTST@ DP 30 (3,0 Decimal)
 * DP contains the 1st position that is not '9' (3, in this case)
C                SUB 1 DP

Response Indicators (Rollup, Rolldown, CAxx, CFxx, etc.) can be renamed as follows:

IRECFMT1
I *IN03 EXIT
I *IN04 PROMPT

Compile-time array

E EXAM 1 5 3

For above line…
1 = # of fields per record
5 = total # of fields in the array
3 = length of each entry

CT Arrays get their data from lines @ end of pgm

**
Line 1
Line 2
** << 2 asterisks separate each set of array data (comments like this are allowed)
Data for 2nd table/array

E EXAM 5 3

For above line…
5 = total # of fields in the array
3 = length of each entry

Run-time Arrays get their data from code in the C-Specs


*ENTRY Parm List

RPG (or CL) doesn't bomb when you pass fewer parms than than in the *ENTRY list, only when you reference the un-passed parms - to avoid this, get the # of passed parms from the SDS:

I SDS
I *PARMS PARMS

V7 adds %ParmNum() - no longer need to hard-code # of parms (i.e., If %Parms > 1;)

 D OptionalTest    PI 
 D   Parm1                             20A 
 D   Optional2                          5P 0 Options(*NoPass) 
 
 D Parm2            S                   5P 0 Inz(99999) 
 
 // Check for optional parameter and use value if present 
 
 If %ParmNum(Optional2) <= %Parms; 
    // do something with Optional2
 Endif;

  • UC @ EOL = User-Controlled Open

/free 
	TotalCost = 0; 
	for i = 1 to SalesTransation.Numproducts; 
		TotalCost = TotalCost + SalesTransaction.Products(i).Cost; 
		dsply SalesTransaction.Products(i).Cost; 
	endfor; 
	dsply (’Total cost is ’ + %char(TotalCost));
/end-free
/free
 
	#exit =;
	#error =;
 
	setll k#plp45 plp45l01;
	reade k#plp45 plp45l01;
	dow not %eof(plp45l01);
 
		if pmth45 = 'CCD';
 
			exsr $detail;
 
		endif;
 
		reade k#plp45 plp45l01;
	enddo;
 
	out lda;
 
	*inlr =*;
 
/end-free
/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
  • Can create a default by creating *DTAARA QRPG/DFTHSPEC, 80 Characters long.
    • This would be included in all compiles.
  • If *DTAARA RPGHSPEC exists in the library list, it over-rides the one in QRPG.

ACTGRP(*NEW | *CALLER | 'activation-group-name') ALWNULL(*NO | *INPUTONLY | *USRCTL) AUT(*LIBRCRTAUT | *ALL | *CHANGE | *USE | *EXCLUDE | 'authorization-list-name') BNDDIR('binding-directory-name' {:'binding-directory-name'…}) CURSYM('sym') DATEDIT(fmt{separator})

(fmt) can be *DMY, *MDY, or *YMD

DATFMT(fmt{separator})

ISO is the default

DEBUG{(*NO | *YES)}

specifies whether DUMP operations are performed

DFTACTGRP(*YES | *NO)

see ACTIVATION GROUPS, below

EXPROPTS(*MAXDIGITS | *RESDECPOS)

same as M and R opcode extenders
controls precision of intermediate calcs

FORMSALIGN{(*NO | *YES)}

if *YES, the first line of output files with 1P indicator can be printed repeatedly, allowing you to align the printer

GENLVL(number)

for compile errors

NOMAIN

for modules

OPTION(*{NO}XREF *{NO}SECLVL *{NO}SHOWCPY *{NO}EXPDDS *{NO}EXT *{NO}SHOWSKP) *{NO}SRCSTMT) *{NO}DEBUGIO)

SECLVL = second-level message text
SHOWCPY expands /COPY directives
EXPDDS expands DDS listings of externally described files
EXT expands external procedure listings
SHOWSKP includes code skipped cuz of /IF directives
NOSRCSTMT indicates that line numbers from /COPY directives are assigned sequentially
DEBUGIO generates breakpoints for all input and output specifications

PRFDTA(*NOCOL | *COL) - for profiling (not performance) data TRUNCNBR(*YES | *NO) USRPRF(*USER | *OWNER)

*OWNER = adopted authority

  • X'C17DC2'

  • ILE lets you bind modules from different languages (RPG can be bound to CL)
  • first step is to compile modules with CrtRpgMod
  • use CrtPgm to bind modules into a callable program
  • can use CrtBndRPG to do both steps (creates a temp *Module object), but it may limit the ILE features
  • if using a NOMAIN subprocedure, you cannot use INZSR or *ENTRY PLIST
  • scope - all variables outside of subprocedures are global
  • scope - all variables within subprodedures are local
  • QILE is default activation group for modules
  • QSRVPGM is default activation group for service pgms
  • default ACTGRPs limit the ILE funcions
    • can't bind objects
    • pgm CALLs can only call other pgms, not procedures
  • allows partitioning of job resources (file overrides, committment definitions, and open files)
  • can control job activation and deactivation, improving performance
  • allows use of shared ODPs
  • if using mixed ILE and non-ILE, use default activation group
  • when an ILE pgm ends, the system doesn't always remove the storage for that pgm activation from the job
  • manual use of RCLACTGRP can improve performance
  • is just a list of modules
  • simplifies binding by storing multiple objects
  • H-Spec can contain the BndDir keyword
  • AddBndDirE adds new modules or service programs
  • WrkBndDir
  • RmvBndDirE
  • for normal (aka, dynamic) CALLs, system resolves all call references at runtime
  • CALLB for modules = Call Bound = binds by copy
  • CALLB uses traditional parm list
  • CALLB for service pgms = Bind by Reference (creates symbolic link to the procedure)
  • CALLP = Call with Prototype
  • Prototype must be defined in D-specs of both calling pgm and called procedure
  • passes parms by reference, by value, or read-only reference
  • MOD prefix for subprocedures/prototypes
  • SPG prefix for service programs
  • BND prefix for binding directories (BND0001)
  • source created as *module suffixed with “M”
  • CRTPGM source members suffixed with “R”
  • Declares the entry parameters for the procedure
  • Parms must be in same order as the prototype
  • Parms *do not* have to use the same names as the prototype parms
  • A prototype is a definition of the call interface
  • A return value (if any) is specified on the PR definition

Keywords (valid for both the return value and parms)

  • DATEFMT()
  • DIM()
  • LIKE()
  • LIKEDS()
  • LIKEREC()
  • PROCPTR - is a procedure pointer
  • TIMEFMT()
  • VARYING

Keywords valid for parms

  • OPTIONS(*NOPASS) - parm is optional
  • VALUE - parm is passed by value
  • does not have a program entry point (it is never called directly)
  • is a collection of modules bound into a single object
  • only 1 copy ever exists
  • always bound by reference
  • can pass parms to subprocedures
  • can define local data and variables
  • can return a value
  • can be used in expressions
  • A subprocedure is a procedure specified after the main source section.
  • It can only be called using a bound call
  • EXPORT is required on “B”egin line of procedure if it wil be called by other modules
  • if no EXPORT, can only be used by current module
 * Prototype for procedure FUNCTION
 D FUNCTION                 PR                            10I 0
 D    TERM1                                                      5I 0 VALUE
 D    TERM2                                                      5I 0 VALUE
 D    TERM3                                                      5I 0 VALUE
 
 P Function                    B
 *-------------------------------------------------------------
 * This procedure performs a function on the 3 numeric values
 * passed to it as value parameters.
 *
 * This illustrates how a procedure interface is specified for a
 * procedure and how values are returned from a procedure.
 *-------------------------------------------------------------
 D FUNCTION                 PI                            10I 0
 D    TERM1                                                      5I 0 VALUE
 D    TERM2                                                      5I 0 VALUE
 D    TERM3                                                      5I 0 VALUE
 
 D Result                       S                              10I 0
 
 /free
     Result = Term1 ** 2 * 17
                       + Term2 * 7 ?5%
                       + Term3;
     return Result * 45 + 23;
 /end-free
 
 P                                  E

Indicators

* saving indicators

C                MOVEA *IN,61 SAV8 8
C                EXSR SUB1
C                MOVEA SAV8 *IN,61

This can also be used for nested subroutines, IF you use different save field names for each subroutine

  • Internal indicators (1P, LR, MR, and RT) are defined by the RPG IV program cycle itself
  • External indicators (U1-U9) can be turned on in CL programs, and can be used as file indicators
  • if indicator is off when pgm is called, the file is not opened
  • Halt indicators - H1-H9
  • Overflow indicators - *INOA through *INOG, *INOV, and *IN01 through *IN99
  • record identifying indicators - defined in the I specs
  • control level indicators - L1-L9 - only for primary or secondary files
  • field indicators - 01-99, H1-H9 - greater than zero, less than zero, zero, or blank
  • function key indicators - for F1-F24 - KA-KM (KO is not used) and KN-KY
  • field record relation indicators - 01-99, H1-H9, L1-L9, LR, U1-U8, RT - on I specs for internally-described files
  • resulting indicators - 01-99, H1-H9, OA-OG, OV, L1-L9, LR, U1-U8, KA-KN, KP-KY (valid only with SETOFF), RT
  • can test the result field after an arithmetic operation, identify a record-not-found condition, indicate an exception/error condition for a file operation, or to indicate an end-of-file condition.
  • Position 7 & 8 of C specs can have L1-L9 or LR
CL1 
    * a calc on this line would only run when L1 is on
CLR 
    * a calc on this line would only run when LR is on

Left Justify

* Find the first non-blank character in FIELD.
C                      ' '                 CHECKFIELD               X
 
* BEFORE, FIELD= " MY TEXT "
* AFTER, FIELD= "MY TEXT "
 
* Extract into itself, starting at that position
C                    X                   IFNE   *ZERO
C                                         SUBSTFIELD:X   FIELD    P
C                                         ENDIF

Right Justify

* Find the LAST non-blank character in FIELD.
C                    ' ' CHEKRFIELD X
* BEFORE, FIELD= "MY TEXT "
* AFTER, FIELD= " MY TEXT"
C                    X IFNE *ZERO
* Determine number of Trailing Blanks.
C                30    SUB     X          X
Concatenate FIELD into itself, which moves the trailing blanks to the front
C                ' '     CAT FIELD:X     FIELD P
C                      ENDIF

Center

* BEFORE, FIELD= "XXXXXXXXXX "
* AFTER, FIELD= " XXXXXXXXXX "
 
* Find the LAST non-blank character in FIELD.
C                 ' ' CHEKRFIELD          X                    X=10
 
* Subtract position of last non-blank character from the length of the output field, which gives the total number of blanks in the output field.
C                50           SUB         X            X        X=40
 
* Get the number of blanks that will be on each side of the data.
C                X               DIV        2           X          X=20
* Concatenate FIELD into CENTER, putting X number of blanks in front of the data
C               ' '               CAT FIELD:X CENTER P

If L5 is turned on, then all lower levels (L1 - L4) are also turned on. The LR indicator automatically turns on all L1 - L9 indicators. Printing and calculations will occur from low to high (L1 > L9)

  • can be manually attached to fields of an internally-described file
  • L1 (below) is attached to the DEPT field
IQSYSPRT ... ... ...
 
I 2 3 DEPT L1
 
I 4 15 SLMN

	H DATFMT(*ISO)
	* Examples of literals used to initialize fields
	DName+++++++++++ETDsFrom+++To/L+++IDc.Keywords+++++++++++++++++++++++++++++
	D DateField 	  S 			  D   INZ(D'1988-09-03')
	D NumField 		  S 			 5P 1 INZ(5.2)
	D CharField 	  S 			10A   INZ('abcdefghij')
	D UCS2Field 	  S 			 2C   INZ(U'00610062')
	* Even though the date field is defined with a 2-digit year, the
	* initialization value must be defined with a 4-digit year, since
	* all literals must be specified in date format specified
	* on the control specification.
	D YmdDate 		  S 			  D   INZ(D'2001-01-13')
	D 									  DATFMT(*YMD)
	* Examples of literals used to define named constants
	D DateConst 	  C 				  CONST(D'1988-09-03')
	D NumConst 		  C 				  CONST(5.2)
	D CharConst 	  C  				  CONST('abcdefghij')
	* Note that the CONST keyword is not required.
	D Upper 		  C      			  'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
	* Note that the literal may be continued on the next line
	D Lower 		  C 				  'abcdefghijklmn-
	D 									  opqrstuvwxyz'

The following lists some examples of valid float literals:

  • 1E1 = 10
  • 1.2e-1 = .12
  • -1234.9E0 = -1234.9
  • 12e12 = 12000000000000
  • +67,89E+0003 = 67890 (the comma is the decimal point)

C           VALUES LOKUP LOOK_INTO HiLoEq 

Lookup for Related Tables

C           VALUES LOKUP LOOK_INTO RELATED HiLoEq 

If a match is found, the “field” called related contains the matching value


Sending Messages Directly from the RPG Program

C                   MSG,1 DSPLYUSERMQ
  • Factor 2 (MsgQ) can be blank
  • Factor 1 contains the message to display.
  • Factor 2: if blank, and the job is batch, the message is sent to QSYSOPR
  • if blank, and the job is interactive, sent to *EXT msgq
C          *MUSR0001 DSPLYUSERMQ
  • Sends message USR0001 from MSGF QUSERMSG. You can use OVRMSGF to use a different msg file
  • If the result field is a variable, the program waits for a response, & puts the response in the variable!

/EJECT
/SPACE #

SCR01
SFL01
CTL01
CMD01

LDA - to make updates to it available to called pgms, must do OUT first

Optional way to define an array as a field:

E                  FLD 12 20
I$FLD DS
I                           1 240 FLD

PGMA calls PGMB, which uses RETRN - when PGMA ends w/ LR on, it doesn't close PGMB's files! You could call PGMB w/ a parm, which tells it to end w/ LR on, or call QCMDEXC from PGMA, executing RCLRSC

Record formats - reading more than 1 from the same screen

    C                     WRITE ABOVE
    C                     WRITE BELOW
    C                     EXFMT SFLCTL
    C                     READ ABOVE 90
    C                     READ BELOW 91

Record Locks - use an error indicator for CHAIN or READ to know if you have a record lock

READE w/ a key - it locks the next record, then compares the key values - this means the first record after the key value will get locked by this process - it also means that this “wrong” record could create a wait state

External PRTFs (instead of O-Specs) allow you to use the same pgm to create 2 or more different (but similar) reports - create the 2nd PRTF (using some of the original fields, or extra fields, different column or report headings, etc.) using LVLCHK(*NO) - use OVRPRTF to direct the output to the new PRTF - you just created a new report w/o doing any RPG coding!

KLIST - you can define fields sizes on KFLD lines

Using CAT, you can “MOVEL” up to 16 characters in one operation:

C                  '12345678'CAT '90ABCDEF'              RESULT

   c               monitor                                     * start monitor
   c               eval      ivinue = ivinue + movc95          * eval equation
   c               on-error  0103                              * field too small
   c               eval      ivinue = *hival                   * reset
   c               endmon                                      * end monitor

  • A “B” near the column # means “blank after”
  • An “F” means Fetch
  • Before printing the total line, the pgm “fetches” all heading output controled by “OF”

  • Use & for field names
WHERE      CONO55 = &CONO
  • Use SETVAR in the CL
STRQMQRY   QMQRY(*LIBL/DONOFRTQ) SETVAR((CONO &CONOW) (LOCD &LOCDW))

  • describes the fields: names, order, size/length, data type, column heading, validity checks, etc.

You can easily rename INPUT fields in RPG using the I specs, but this doesn't work for Output-only files. To accomplish this, define the file as Input, Full Procedural w/ Add, and add a “dummy” read - now you can re-define your “output” field.


  • The RRN of a record, even from a keyed file, is in positions 397-400 of INFDS (in Binary).
  • The INFDS is updated only when a block of records is written
    • may need to use OVRDBF SEQONLY(*YES 1)

4 is placed in RESULT, and *IN66 is turned on

                                                                             HiLoEq
C            'ABC'     SCAN     'XYZABCII'     RESULT               5566

The Scan starts at position 3

C          'ABC'      SCAN    FLDA:3              RESULT             5566

I SDS
I                           1 10 $$PGM
I                     244 253 $$WS
I                     254 263 $$USER
I                     264 269 $$JOB

Multiple programs can write to the same printer file - start w/ OVRPRTF FILE(QSYSPRT) SHARE(*YES)

The 1st RPG program can be a simple little thing that only opens the file:

FQSYSPRT  O    F      132      OF      PRINTER
C                                  RETRN
C                                  EXCPTDUMMY
C                                  MOVE *ON *INLR
OQSYSPRT  E                    DUMMY

You can end the process by using RCLRSC in the CL. As an alternative, you can pass a parm to the first & last programs to control opening & closing the file.


DECLARE ...
OPEN ...
FETCH NEXT ...
Loop, CHECK FOR Error Code
CLOSE...

alias

an alternate name for a table, view, or member
CREATE ALIAS MYLIB.MYMBR2_ALIAS FOR MYLIB.MYFILE(MBR2)

Alter Table

add/drop/alter columns
add/drop constraints

Comment On

adds long text (2000 char max for V5R3) to object

Constraint

database rules (unique, referential, or check)

Create commands create 2 names - an SQL name (128 char max) and a system name (10 char max) Create Table (PF)

CREATE TABLE xxx AS SELECT...
creates a table using a subset of field from an existing table
CREATE TABLE xxx LIKE MyTable...
all fields in referenced table used in created table

Create View

(LF - unkeyed)

Create Index

(LF - keyed)

data dictionary

a set of tables containing object definitions

DECLARE cname CURSOR

the default “declare cursor” only allows 1 retrieval per record, and there's no navigating backwards

DECLARE cname SCROLL CURSOR

to enable fetch prior or fetch first, use a scrollable cursor

Drop

deletes database objects

Fetch Next From … For 10 Rows Into :DS Functions (UDFs)

execute like BIFs (meaning, inline within code)

Index

keyed LF

Insert Into MyFile 10 Rows Values :DS Label On

adds text (50 chars) and/or column heading (60 chars)

Rename

for objects, including system name portions of object names
Rename Table Customer_Master To SYSTEM NAME CustMast

schema

consists of a library, a journal, a journal receiver, a catalog, and optionally, a data dictionary

sequence

a data area object that provides a quick and easy way of generating unique numbers

Stored Procedure

executed via CALL statement

System Name

Create commands create 2 names - an SQL name (128 char max) and a system name (10 char max)
see below for SQL over system table
may want to rename them

trigger

a set of actions that are run automatically whenever a specified event occurs to a specified base table

UDT

CREATE DISTINCT TYPE US_DOLLAR AS DECIMAL (9,2)
can then create tables with field types of US_DOLLAR (or string, integer, etc.)

view

can point to multiple tables, can have a subset of columns
 CREATE FUNCTION CUSPRC
 (IN VARCHAR(8), VARCHAR(3), VARCHAR(15)) RETURNS VARCHAR(30)
 EXTERNAL NAME '&LIB/GETCUSPRCF(CUSPRC)'
 LANGUAGE RPGLE
 PARAMETER STYLE SQL
 NOT DETERMINISTIC

CREATE FUNCTION PMGTPOOQ (CONO VARCHAR(2), ORDN VARCHAR(7) ,
ITEM VARCHAR(15)) RETURNS  DECIMAL(15,3)
LANGUAGE SQL
NOT DETERMINISTIC
BEGIN
DECLARE ORDQTY DECIMAL(15,3);
SELECT SUM(OQTY03) INTO ORDQTY  FROM PMP03
WHERE CONO03=CONO AND ORDN03=ORDN AND ITEM03=ITEM
AND DTLC03 = 9999999 AND BOSN03=0 AND ACRC03=' ' AND
DLTF03=' ' AND SUBSTR(ORDN03,1,1) IN('P','S');
RETURN ORDQTY;
END

     C/EXEC SQL
     C+ declare cGLC1 cursor for
     C+ select max(prdt)
     C+ into :w_pdate
     C+ from
     C+  where
     C/END-EXEC
 
     c/exec sql
     c+ open cGLC1
     c/end-exec
 
     c                   dow       all_cglc1 = *off
     c/exec sql
     c+ fetch next from cGLC1
     c+ into  :#pstamt, :#sesno, :#prlssn
     c+
     c/end-exec
 
     c                   if        sqlcod = 0
               * process data
     c                   else
               * EOF (or an error)
 
     c/exec sql
     c+                  close     cGLC1
     c/end-exec
     c                   endif
 
     c                   enddo

     C/EXEC SQL
     C+ insert into cusprcp
     C+
     C+ Select
     C+  'C',
     C+  CONO70 CONO,
     C+  LOCD70 LOCD,
     C+  CUSN70 CUSN,
     C+  DSEQ70 DSEQ,
     C+  CATN70 CATN,
     C+  :pdate PRDT
     C+ from
     C+  inp20
     C+  Join oep70 on cono20 = cono70 and strc20 = locd70
     C+
     C+  Where
     C+   CONO20 = 'D1'
     C+   and DEPC20 = 'MFG'
     C+   and pern70 > LEFT(DEC(DEC(Replace(CHAR(CURRENT DATE  - 13 Months,
     C+  ISO), '-', '')) - 19000000,7,0) ,5)
     C+   and lqty70 > 0
     C+  GROUP BY
     C+   CONO70,
     C+   LOCD70,
     C+   CUSN70,
     C+   DSEQ70,
     C+   CATN70
     C+
     C/END-EXEC

	D Pmp02Rec      E DS                  EXTNAME(Pmp02)
 
	EXEC SQL SELECT * INTO :Pmp02Rec FROM PMP02
			WHERE ORDN02=SUBSTRING(:Lda,349,7) AND DTLC02=9999999;

       EXEC SQL SELECT DSCUSCO||DSCUSN||DSDSEQ
                INTO :LocationValue FROM OEIDSPF
                WHERE DSPO=:Po;
       IF  SqlCod<>0;
           LocationValue=*BLANK;
       ENDIF;

  • Is there a SYSTABLES for each schema?
  • Also in QSYS2
SELECT System_Table_Name,
          System_Table_Schema,
          TABLE_NAME
FROM SysTables
WHERE TABLE_NAME = "Customer_Master"

     C/exec sql
     C+     set option commit=*none,closqlcsr=*endmod
     C/end-exec
 
     C/EXEC SQL
     C+ select max(prdt)
     C+ into :w_pdate
     C+ from cusprcp
     C+  where prtyp = 'C'
     C/END-EXEC
 
     C/EXEC SQL
     C+ delete from cusprcp
     C+  where prtyp = 'C'
     C/END-EXEC
 
     C/EXEC SQL
     C+ update cusprcp
     C+ set prtyp = 'H'
     C+  where prtyp = 'C'
     C/END-EXEC

V7 can process the result set from a proc

RPG stored procedures have always been able to return a result set

  • But we could not receive/process that result set in an RPG program

This new support may feel a bit “clunky” - But it works - You need to …

  • Define a RESULT_SET_LOCATOR (defined on D spec)
  • Then ASSOCIATE the Result Set Locator with the Procedure
  • Then ALLOCATE the CURSOR for the result set
D CustResultSet S SQLType(RESULT_SET_LOCATOR) 
 Exec SQL Call CustomersByState( :InputState ); 
 Exec SQL Associate Result Set Locator (:CustResultSet) 
     with Procedure CustomersByState; 
 
 Exec SQL Allocate C1 Cursor for Result Set :CustResultSet; 
 Exec SQL Fetch next from C1 into :CustData; 
Traditional Syntax Free-Form Syntax
CAT + operator
CHECK %CHECK
CHECKR %CHECKR
%STR
%REPLACE
SCAN %SCAN
SUBST %SUBST
XLATE %XLATE
TRIM %TRIM
TRIML %TRIML
TRIMR %TRIMR

Find the first non-zero non-blank character - Note that Factor 1 contains a space, followed by a Zero

C           ' 0'   CHECK  FIELD    X

* BEFORE, FIELD= “000048006” * If any non-zero non-blank character was found. AFTER, FIELD= “ 48006”

C            X      IFNE   *ZERO

Translate all zeros to blanks

C           '0':' ' XLATE  FIELD    FIELD

Translate all blanks back to zeros, starting at the position of the first non-zero non-blank character

C           ' ':'0' XLATE  FIELD:X   FIELD
C           ENDIF

CSRLOC(ROW COLUMN)

where to make the cursor appear

Error Handling

turn on indicator for DSPATR(RI PC) for fields with errors

Page Size

if page size = SFL size, then pgm must handle PAGEUP and PAGEDN
also, if the last record exactly fills the page, the pgm shows More, even though there are no more

: read ahead to see if we're @ EOF, then readp, then show More or Bottom ROLLDOWN (same as PAGEUP) - use same indicator as SFLDSP ROLLUP (same as PAGEDOWN) - use same indicator as SFLDSP RTNCSRLOC(&CSRRCD &CSRFLD &CSRFLP)

2 formats - this format retrieves record name, field name, and option al cursor location within the field

RTNCSRLOC(*WINDOW &CSRROW &CSRCOL &WDWROW &WDWCOL)

2 formats - this format retrieves the cursor row and column

SFLCLR

clear the subfile - duh!
Use the same indicator as SFLDSPCTL, except SFLDSP uses “Not on”

SFLDSP

Only show/display the SFL when this is on

SFLDSPCTL

Only show/display the control record when this is on

SFLNXTCHG

forces record to appear changed
user presses Enter, validate screen, errors found, turn on SFLNXTCHG and error indicator, write back to screen
cuz SFLNXTCHG is on, if the user just presses Enter, the error records will appear changed

  • see ILE section

The test operations are: TEST

Test Date/Time/Timestamp

TESTB

Test Bit

TESTN

Test Numeric

TESTZ

Test Zone

Translate characters in Factor 2 based on Factor 1

  • Factor 1: FROM:TO
  • Factor 2: Field containing data to Translate. Optional colon, followed by starting position
  • Result Field: Translated result is placed here.

Translate all lower case characters to upper case (LWR & UPR need to be constants or tables)

C                LWR:UPR XLATE   FIELD    FIELD

Old-School Column Markers

*...1....+....2....+....3....+....4....+....5....+....6....+....7...
IFilename++SqNORiPos1+NCCPos2+NCCPos3+NCC................................
I........................Fmt+SPFrom+To+++DcField+++++++++L1M1FrPlMnZr....
DName+++++++++++ETDsFrom+++To/L+++IDc.Keywords+++++++++++++++++++++++++++++
CL0N01Factor1+++++++Opcode(E)+Factor2+++++++Result++++++++Len++D+HiLoEq..
OFilename++DF..N01N02N03Excnam++++B++A++Sb+Sa+...........................
O..............N01N02N03Field+++++++++YB.End++PConstant/editword/DTformat
Enter your comment. Wiki syntax is allowed:
I I F Y B
 
  • blog/iseries/rpg.txt
  • Last modified: 2020/03/07 04:37
  • by tom