AS400/iSeries CL Notes
*CAT (concatenation, symbol ||)
*BCAT (concatenation, 1 Blank between strings, symbol |>)
*TCAT (concatenation, NO blanks between strings, symbol |<)
? - Use before a command to prompt the user - ?wrkactjob, ?wrkjob, etc.
/* + Comment, Line 1 + Line 2 + Line 3 + */
Allocate Object (ALCOBJ)
ALCOBJ OBJ((&MYLIB/XYZ *FILE *EXCL)) MONMSG MSGID(CPF1002) EXEC(DO) /* can not allocate */ SNDBRKMSG MSG('Can not exclusivly allocate file XYZ. + Eliminate the locks and restart this job...') TOMSGQ(&JOB) GOTO ENDALL ENDDO
Binary Conversion
%BIN format can be the same as %SST: %BIN(&field &start &length)
Binary in arithmetic operations
CHGVAR &VAR1 (%BIN(&bw2) + 4)
Process: convert &bw2 to decimal, add 4 to it, put results in &var1
Binary to Decimal
DCL &dec *dec (3 0) DCL &bw2 *char 2 VALUE(x'0012') /* A 2-byte binary work field. Must be 2 or 4 bytes. */ CHGVAR &dec %BIN(&bw2)
Process: &bw2 (binary 12, defined in hex), is converted to decimal, and put in &dec
Date Validation
CVTDAT DATE(&date) TOVAR(&date) FROMFMT(*mdy) TOFMT(*mdy) MONMSG CPF0000 DO(error_processing)
Since the From & To formats are the same, no conversion is actually done. but an error message is sent if the date is invalid (which will be trapped by the MONMSG comand.)
Decimal to Binary
CHGVAR %BIN(&bw2) &dec
Process: &dec is converted to a 2-byte signed binary number, and placed in &bw2
File I/O
DCLF FILE(*LIBL/YOURFILE) READFILE: RCVF MONMSG MSGID(CPF0864) EXEC(GOTO CMDLBL(ENDFILE)) /* End of File */ /* do stuff */ GOTO CMDLBL(READFILE) ENDFILE:
IF ... THEN ... ELSE
IF COND(&value *EQ 123) THEN(DO) STATEMENT 1 STATEMENT 2 enddo else cmd(DO) STATEMENT 3 STATEMENT 4 enddo IF ( &SFOPT *EQ '2' *AND &SFTYPE *EQ 'J' ) DO commands ENDDO ELSE IF ...
Messages, Displaying in Reverse Image
DCL &reverse *char 1 VALUE(x'21') DCL &normal *char 1 VALUE(x'20') SNDPGMMSG MSGID() MSGF() MSGDTA(&reverse || &msg || &normal) TOPGMQ(*ext)
MISC.
Overrides end when CL Ends
PRTF, Using the same one Twice (in 2 separate RPG Programs)
OVRPRTF FILE(prt1) TOFILE(extprtf) SPLFNAME(prt1) OVRPRTF FILE(prt2) TOFILE(extprtf) SPLFNAME(prt2)
Rename the record formats for both PRT1 and PRT2 in the RPG programs.
RCVMSG
RCVMSG PGMQ(*same) MSGTYPE(*info) SENDER(&sender) RMV(*yes/*no) MSGKEY(&msgkey)
- SENDER Format: Job (10), User (10), Job # (6), (All 3 for the Sending Job)
Can use this to get the Current Program name:
SNDPGMMSG MSG(' ') TOPGMQ(*same) MSGTYPE(*info) KEYVAR(&msgkey) RCVMSG PGMQ(*same) MSGTYPE(*info) SENDER(&sender) RMV(*yes) MSGKEY(&msgkey) CHGVAR VAR(&pgm) VALUE(%SST(&sender 56 10))
Reading Data File
dclf FNAME /* Declare file */ LOOP: rcvf /* Get Record */ monmsg CPF0000 goto ELOOP /* Leave loop on EOF */ STATEMENT 1 STATEMENT 2 /* After statements processed */ goto LOOP /* GOTO beginning of loop */ ELOOP:
All fields in FNAME are automatically defined (&FIELD)
Records, Redefining them (Parsing a large field or Record Format)
If a file contains large fields that you need to parse, follow these steps:
- Define a new file w/ the same record length with the smaller fields defined.
- OVRDBF FILE(New_File) TOFILE(Old_File) LVLCHK(*no)
- This Parses the Old file, using the Definition from the New file
- By doing a DCLF before the Over-ride and a RCVF after, you can get numeric data (into numeric CL fields) from a large character field
Self-Submitting CL
To have a CL submit itself to batch, use:
RTVJOBA TYPE(&jobtype) IF COND(&jobtype *eq '0') THEN this is Batch IF COND(&jobtype *eq '1') DO(SBMJOB ...)
Structure
DCL &field1 *CHAR 7 'init value' DCL &fld2 *CHAR 132 CHGVAR &fld2 %SST( &field1 1 10) CALL program1 ( + &sbs /* Subsystem name */ + &sbslib /* Subsystem Library */ + ) IF ( &msgid *NE &blanks ) DO SNDPGMMSG MSGID( &msgid ) + MSGDTA( &msgdta ) + MSGF( qcpfmsg ) + MSGTYPE( *DIAG )
Subroutines
CHGVAR &rtnloc 'LOC1' GOTO SUBR1 LOC1: CHGVAR &rtnloc 'LOC2' GOTO SUBR2 LOC2: * Beginning of Subroutine #1 ***** SUBR1: commands commands GOTO NAVIGATE * Beginning of Subroutine #2 ***** SUBR2: commands commands GOTO NAVIGATE * Navigate to Correct Return Point ***** NAVIGATE: IF (&rtnloc *EQ 'LOC1') THEN(GOTO LOC1) IF (&rtnloc *EQ 'LOC2') THEN(GOTO LOC2)
Discussion