blog:iseries:cl

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 +
*/

	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

%BIN format can be the same as %SST: %BIN(&field &start &length)


CHGVAR &VAR1 (%BIN(&bw2) + 4)

Process: convert &bw2 to decimal, add 4 to it, put results in &var1


 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


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


CHGVAR %BIN(&bw2) &dec

Process: &dec is converted to a 2-byte signed binary number, and placed in &bw2


             DCLF       FILE(*LIBL/YOURFILE)

 READFILE:   RCVF
             MONMSG     MSGID(CPF0864) EXEC(GOTO CMDLBL(ENDFILE)) /* End of File */

		/* do stuff */

             GOTO       CMDLBL(READFILE)
 ENDFILE:

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

DCL &reverse *char 1 VALUE(x'21')
DCL &normal *char 1 VALUE(x'20')

SNDPGMMSG MSGID() MSGF() MSGDTA(&reverse || &msg || &normal) TOPGMQ(*ext)

Overrides end when CL Ends


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

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)


If a file contains large fields that you need to parse, follow these steps:

  1. Define a new file w/ the same record length with the smaller fields defined.
  2. OVRDBF FILE(New_File) TOFILE(Old_File) LVLCHK(*no)
    1. This Parses the Old file, using the Definition from the New file
  3. 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

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

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 )

 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)
Enter your comment. Wiki syntax is allowed:
M N S O C
 
  • blog/iseries/cl.txt
  • Last modified: 2020/01/25 02:51
  • (external edit)