Show pageOld revisionsBacklinksFold/unfold allBack to top This page is read only. You can view the source, but not change it. Ask your administrator if you think this is wrong. [[me:as400: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 \\ ------------------------------------------------------------------------------- ===== ARRAYS ===== 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<code rpgfree>C Z-ADD15 ARRAY</code> Each element of ARRAY1 will be added to the corresponding element of ARRAY2<code rpgfree>C ADD ARRAY1 ARRAY2</code> ------------------------------------------------------------------------------- ===== BIFs ===== %Abs : absolute value %Char : converts to character<code rpgfree>%CHAR(date : *iso)</code> %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<code rpgfree>DIV = %DIV(A:B); (divide A by B)</code> %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 Description|No Sign|CR Sign|-Sign (R)|-Sign (L)| |Commas and zero balances|1|A|J|N| |Commas|2|B|K|O| |Zero balances|3|C|L|P| |No commas or zero balances|4|D|M|Q| |User-defined edit codes|5-9| |Date edit (4 digits)|W| |Date edit|Y| |Suppress leading zeros|Z| %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 * <nowiki>'b*bbbbbb.bb' (each b is a blank/space character) applied to 12345 prints ***123.45</nowiki> * 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<code rpgfree> REM = %REM(A:B);</code> %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) <code rpgfree> 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))</code> %Subdt(date: unit) : "date substring" - portion of a date <code rpgfree> %SUBDT(value:*MSECONDS|*SECONDS|*MINUTES|*HOURS|*DAYS|*MONTHS|*YEARS) %SUBDT(value:*MS|*S|*MN|*H|*D|*M|*Y)</code> %Subst : substring(string:start:length) <code rpgfree> // After the EVAL the original value of A contains ’ab****ghijklmno’ %SUBST(A(3:4))= ’****’;</code> %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) ------------------------------------------------------------------------------- ===== C-Specs ===== 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<code rpgfree> C eval x = a + b C eval x = a + C b C eval x = 'abc' C eval x = 'ab+ C c'</code> Continuation for field names use elipses<code rpgfree>C eval MyLongF... C ieldName = A + B</code> That even works on D-Spec names, constants, and literals * note that the 'S'tandalone indicator and field size are on the next line<code rpgfree> D QuiteLongFieldNameThatCannotAlwaysFitInOneLine... D S 10A * DNUMERIC C 12345 D 67</code> ------------------------------------------------------------------------------- ===== CALL ===== <code rpgfree>C CALL 'PGM' BBERLR C VAR1 PARM VAR2 PASS1 10</code> * 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 ===== CHAIN(EN) : (E) enables exception handling : (N) do not lock the record <code rpgfree> CL0N01Factor1+++++++Opcode(E)+Factor2+++++++Result++++++++Len++D+HiLoEq.. C KEY CHAIN FILE NRERBB</code> * NR = indicator seton if no record found * ER = indicator seton if error in called pgm * BB = empty/blank value ====%kds() sample ==== <code rpgfree> DName+++++++++++ETDsFrom+++To/L+++IDc.Keywords+++++++++++++++++++++++++ D custRecKeys ds likerec(custRec : *key)</code> <code rpgfree>/free // custRecKeys is a qualified data structure custRecKeys.name = customer; custRecKeys.zip = zipcode; // 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;</code> ---- ===== CHECK & CHECKR ===== 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. <code rpgfree>C VALID CHECKFIELD X</code> This does the same validation, but it starts checking at position 2. <code rpgfree>C VALID CHECKFIELD:2 X</code> This finds the first non-blank character in FIELD. <code rpgfree>C ' ' CHECKFIELD X</code> This finds the LAST non-blank character in FIELD. <code rpgfree>C ' ' CHEKRFIELD X</code> ------------------------------------------------------------------------------- ===== CLEAR vs. RESET ===== 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. ------------------------------------------------------------------------------- ===== CL Commands in RPG ===== 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. ------------------------------------------------------------------------------- ===== COMP ===== <code rpgfree> CL0N01Factor1+++++++Opcode(E)+Factor2+++++++Result++++++++Len++D+HiLoEq.. C HOURS COMP 40 HiLoEq</code> * Hi indicator seton if Hours is higher than 40 * Lo indicator seton if Hours is lower than 40 * Eq indicator seton if Hours = 40 ------------------------------------------------------------------------------- ===== Control Break flow/process ===== - A record is read - Level testing is performed: LR...L3, L2, L1 - any level will turn on indicators for all lower levels - Control level calculations are performed in sequence: L1, L2...LR. The calculations must be coded in that sequence as well. - Control level totals are printed in sequence: L1, L2 ... LR. The output specs must be coded in that sequence as well. - If LR is off, detail calcs and printing are performed - If LR is off, all level indicators are turned off and another record is read. ------------------------------------------------------------------------------- ===== /COPY and /INCLUDE ===== * 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 <code rpgfree>/COPY libraryname/filename,membername /COPY filename,membername /COPY membername</code> ------------------------------------------------------------------------------- ===== D-SPECS ===== * 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) ------------------------------------------------------------------------------- ===== Data Areas ===== This defines TOTAL as a Data Area <code rpgfree>C *NAMVAR DEFN TOTAL</code> This retrieves the Data Area, but also puts an exclusive lock on it <code rpgfree>C *LOCK IN TOTAL</code> *LOCK is optional This Updates the Data Area, (the optional *LOCK makes it Not Release the Lock) <code rpgfree>C *LOCK OUT TOTAL</code> *LOCK is optional * Define Data areas<code rpgfree> 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</code> ------------------------------------------------------------------------------- ===== Data Structures ===== * 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: <code rpgfree> FCUSTMASTIF E K DISK ICUSTDS E DSCUSTMAST</code> The DS CUSTDS is now defined with every field in the file CUSTMAST. You could even define CUSTDS to be multiple ocurring! Typical DS: <code rpgfree> I DS I 1 6 DATE I 7 12 DATE2 </code> 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_) ------------------------------------------------------------------------------- ===== Data Structure Debugging ===== 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: - 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) - 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: <code rpgfree>ADDBKP 123.00 PGMVAR('/1234') - the '1234' is the ODT DSPPGMVAR PGMVAR('/1234') </code> ------------------------------------------------------------------------------- ===== Dates ===== * UDATE is a 6-digit job date * *DATE is an 8-digit job date * *MDY has separators * *MDY0 DOES NOT have separators ==== Date Math ==== Date math uses normal math symbols (date1 + %days(5)) ------------------------------------------------------------------------------- ===== Debug ===== 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 ------------------------------------------------------------------------------- ===== Decimal Data Errors ===== 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): <code rpgfree> Ffilename UP E DISK C UPDATRcdFmt </code> ------------------------------------------------------------------------------- ===== Determine Field Length ===== <code rpgfree> 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)</code> LEN now contains the length of CUSTNO ------------------------------------------------------------------------------- ===== Determine Number of Decimal Positions ===== <code rpgfree> 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</code> ------------------------------------------------------------------------------- ===== Display File Indicators ===== Response Indicators (Rollup, Rolldown, CAxx, CFxx, etc.) can be renamed as follows:<code rpgfree> IRECFMT1 I *IN03 EXIT I *IN04 PROMPT</code> ------------------------------------------------------------------------------- ===== E-Specs ===== Compile-time array <code rpgfree>E EXAM 1 5 3</code> 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 <code rpgfree> ** Line 1 Line 2 ** << 2 asterisks separate each set of array data (comments like this are allowed) Data for 2nd table/array </code> ------------------------------------------------------------------------------- ===== Run-time array ===== <code rpgfree>E EXAM 5 3</code> 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: <code rpgfree> I SDS I *PARMS PARMS</code> V7 adds %ParmNum() - no longer need to hard-code # of parms (i.e., If %Parms > 1;) <code rpgfree> 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; </code> ------------------------------------------------------------------------------- ===== F-Specs ===== * UC @ EOL = User-Controlled Open ------------------------------------------------------------------------------- ===== /free samples ===== ==== Loop through a mult. occur DS ==== <code rpgfree> /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 </code> ==== Loop through a file ==== <code rpgfree> /free #exit = no; #error = no; 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 = *on; /end-free </code> ==== Loop through a file 2 ==== <code rpgfree> /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 </code> ==== Monitor for (and ignore) an error ==== <code rpgfree> /free monitor; p#cono = 'D1'; today_date = %editc(%dec(%date():*cymd) : 'X'); p#fdat = %dec(today_date:7:0); /end-free </code> ==== SQL Sample ==== <code rpgfree> 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; </code> ==== Sample leave/iter ==== <code rpgfree> /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 </code> ==== Sample Run a CL command inside RPG ==== <code rpgfree> 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 </code> ===== H-Specs (header specs) ===== * 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 ------------------------------------------------------------------------------- ===== hex constants ===== * X'C17DC2' ------------------------------------------------------------------------------- ===== ILE ===== * 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 ==== ACTIVATION GROUPS ==== * 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 ==== BINDING DIRECTORIES ==== * 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 ==== CALLS ==== * 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 ==== NAMING CONVENTONS (suggested for ILE objects) ==== * 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" ==== PROCEDURE INTERFACE (PI) ==== * 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 ==== PROTOTYPES (PR) ==== * 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 ==== SERVICE PROGRAMS ==== * 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 ==== SUBPROCEDURES ==== * 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 ==== Code Sample ==== <code rpgfree> * 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 </code> ------------------------------------------------------------------------------- Indicators * saving indicators <code rpgfree> C MOVEA *IN,61 SAV8 8 C EXSR SUB1 C MOVEA SAV8 *IN,61</code> 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 <code rpgfree> CL1 * a calc on this line would only run when L1 is on</code> <code rpgfree> CLR * a calc on this line would only run when LR is on</code> ------------------------------------------------------------------------------- ===== Justify a Field ===== Left Justify <code rpgfree> * 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 </code> Right Justify <code rpgfree> * 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</code> Center <code rpgfree> * 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 </code> ------------------------------------------------------------------------------- ===== Level Indicators ===== 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 <code rpgfree> IQSYSPRT ... ... ... I 2 3 DEPT L1 I 4 15 SLMN</code> ------------------------------------------------------------------------------- ===== Literals ===== <code rpgfree> 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'</code> ==== float literals ==== 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) ------------------------------------------------------------------------------- ===== LOKUP ===== <code rpgfree>C VALUES LOKUP LOOK_INTO HiLoEq </code> Lookup for Related Tables <code rpgfree>C VALUES LOKUP LOOK_INTO RELATED HiLoEq </code> If a match is found, the "field" called related contains the matching value ------------------------------------------------------------------------------- ===== Messages ===== Sending Messages Directly from the RPG Program <code rpgfree> C MSG,1 DSPLYUSERMQ</code> * 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 <code rpgfree> C *MUSR0001 DSPLYUSERMQ</code> * 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! ------------------------------------------------------------------------------- ===== MISC. ===== /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: <code rpgfree> E FLD 12 20 I$FLD DS I 1 240 FLD</code> 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 <code rpgfree> C WRITE ABOVE C WRITE BELOW C EXFMT SFLCTL C READ ABOVE 90 C READ BELOW 91</code> 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: <code rpgfree> C '12345678'CAT '90ABCDEF' RESULT</code> ------------------------------------------------------------------------------- ===== Monitor (for errors) ===== <code rpgfree> 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 </code> ------------------------------------------------------------------------------- ===== O-Specs ===== * 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" ------------------------------------------------------------------------------- ===== QMQRY ===== * Use & for field names <code sql>WHERE CONO55 = &CONO</code> * Use SETVAR in the CL <code sql>STRQMQRY QMQRY(*LIBL/DONOFRTQ) SETVAR((CONO &CONOW) (LOCD &LOCDW))</code> ------------------------------------------------------------------------------- ===== Record Format ===== * describes the fields: names, order, size/length, data type, column heading, validity checks, etc. ------------------------------------------------------------------------------- ===== Renaming fields in RPG ===== 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. ------------------------------------------------------------------------------- ===== RRN ===== * 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)%% ------------------------------------------------------------------------------- ===== SCAN ===== 4 is placed in RESULT, and *IN66 is turned on <code rpgfree> HiLoEq C 'ABC' SCAN 'XYZABCII' RESULT 5566</code> The Scan starts at position 3 <code rpgfree>C 'ABC' SCAN FLDA:3 RESULT 5566</code> ------------------------------------------------------------------------------- ===== SDS ===== <code rpgfree> I SDS I 1 10 $$PGM I 244 253 $$WS I 254 263 $$USER I 264 269 $$JOB</code> ------------------------------------------------------------------------------- ===== Shared Print File ===== 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: <code rpgfree> FQSYSPRT O F 132 OF PRINTER C RETRN C EXCPTDUMMY C MOVE *ON *INLR OQSYSPRT E DUMMY</code> 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. ------------------------------------------------------------------------------- ===== SQL ===== <code sql> DECLARE ... OPEN ... FETCH NEXT ... Loop, Check for Error Code CLOSE...</code> alias : an alternate name for a table, view, or member <code sql>CREATE ALIAS MYLIB.MYMBR2_ALIAS FOR MYLIB.MYFILE(MBR2)</code> 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) <code sql>Create Table xxx As Select...</code> : creates a table using a subset of field from an existing table <code sql>Create Table xxx Like MyTable...</code> : 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 <code sql>CREATE DISTINCT TYPE US_DOLLAR AS DECIMAL (9,2)</code> : 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 (UDF) from a different source member ==== <code sql> 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</code> ------------ ==== Create Function (UDF) from included code ==== <code sql> 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</code> ------------ ==== Cursor sample ==== <code rpgfree> 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 </code> ------------ ==== "insert into" example ==== <code rpgfree> 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 </code> ------------------------------------------ ==== Select Into a DS ==== <code rpgfree> D Pmp02Rec E DS EXTNAME(Pmp02) EXEC SQL SELECT * INTO :Pmp02Rec FROM PMP02 WHERE ORDN02=SUBSTRING(:Lda,349,7) AND DTLC02=9999999;</code> ------------ ==== Simple SQL without a cursor ==== <code sql> EXEC SQL SELECT DSCUSCO||DSCUSN||DSDSEQ INTO :LocationValue FROM OEIDSPF WHERE DSPO=:Po; IF SqlCod<>0; LocationValue=*BLANK; ENDIF; </code> ------------ ==== System Name from SYSTABLES ==== * Is there a SYSTABLES for each schema? * Also in QSYS2 <code sql> Select System_Table_Name, System_Table_Schema, Table_Name FROM SysTables WHERE Table_Name = "Customer_Master"</code> ------------------------------------------------------------------------------- ==== "set option" example ==== <code rpgfree> 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 </code> ------------------------------------------------------------------------------- ===== Stored Procedures ===== 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 <code rpgfree> 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; </code> ===== Strings ===== ^ 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 | ===== Strip Leading Zeros ===== Find the first non-zero non-blank character - Note that Factor 1 contains a space, followed by a Zero <code rpgfree>C ' 0' CHECK FIELD X</code> * BEFORE, FIELD= "000048006" * If any non-zero non-blank character was found. AFTER, FIELD= " 48006" <code rpgfree>C X IFNE *ZERO</code> Translate all zeros to blanks <code rpgfree>C '0':' ' XLATE FIELD FIELD</code> Translate all blanks back to zeros, starting at the position of the first non-zero non-blank character <code rpgfree>C ' ':'0' XLATE FIELD:X FIELD C ENDIF</code> ------------------------------------------------------------------------------- ===== Subfiles ===== 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 ------------------------------------------------------------------------------- ===== Subprocedures ===== * see ILE section ------------------------------------------------------------------------------- ===== TEST ===== The test operations are: TEST : Test Date/Time/Timestamp TESTB : Test Bit TESTN : Test Numeric TESTZ : Test Zone ------------------------------------------------------------------------------- ===== XLATE ===== 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) <code rpgfree>C LWR:UPR XLATE FIELD FIELD</code> Old-School Column Markers <code> *...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 </code> blog/iseries/rpg.txt Last modified: 2020/03/07 04:37by tom Log In
tom