Here is a useful technique that helps me work with nested levels of IF/DO/CAS structures in RPG programs. It adds nesting level information (like what is found on a compiled printout) to columns 1-5 of the source. For example: "B001," "B002" "E002" and "E001." I find this helpful when I go into SEU, since that information is online for me to look at.

Command Write RPG Levels (WRTRPGLVL, 3a) asks for library, RPG source file and member, and an option. The option lets you clear out positions 1-5 only, without adding the nesting information. The command calls CL program RPG001CL (3b) which validates the names of the library, source file and member, and then calls RPG program RPG001CL (3c) which adds the nesting level information in columns 1-5 or clears the same columns.

Command Write RPG Levels (WRTRPGLVL, Figure 3a) asks for library, RPG source file and member, and an option. The option lets you clear out positions 1-5 only, without adding the nesting information. The command calls CL program RPG001CL (Figure 3b) which validates the names of the library, source file and member, and then calls RPG program RPG001CL (Figure 3c) which adds the nesting level information in columns 1-5 or clears the same columns.

TechTalk: Help with RPG Nesting Levels

Figure 3A Command WRTRPGLVL

 WRTRPGLVL: CMD PROMPT('Write RPG Nesting Levels') PARM KWD(SRCFILE) TYPE(NAME1) MIN(1) PROMPT('RPG + source file') PARM KWD(MBR) TYPE(*NAME) LEN(10) MIN(1) + PROMPT('Member') PARM KWD(OPTION) TYPE(*CHAR) LEN(6) RSTD(*YES) + DFT(*NEST) VALUES(*NEST *CLEAR) + PMTCTL(*PMTRQS) PROMPT('Option') NAME1: QUAL TYPE(*NAME) LEN(10) MIN(1) QUAL TYPE(*NAME) LEN(10) MIN(1) PROMPT('Library') 
 
 TechTalk: Help with RPG Nesting Levels
 
 Figure 3B CL program RPG001CL
 
 RPG001CL: + PGM PARM(&SRCFILE &MBR &OPTION) DCL VAR(&LIB) TYPE(*CHAR) LEN(10) DCL VAR(&MBR) TYPE(*CHAR) LEN(10) DCL VAR(&MSG) TYPE(*CHAR) LEN(80) DCL VAR(&OPTION) TYPE(*CHAR) LEN(6) DCL VAR(&SRCF) TYPE(*CHAR) LEN(10) DCL VAR(&SRCFILE) TYPE(*CHAR) LEN(20) /* Break qualified name */ CHGVAR VAR(&SRCF) VALUE(%SST(&SRCFILE 1 10)) CHGVAR VAR(&LIB) VALUE(%SST(&SRCFILE 11 10)) /* Validate input */ CHKOBJ OBJ(&LIB/&SRCF) OBJTYPE(*FILE) MBR(&MBR) MONMSG MSGID(CPF9810) EXEC(DO) CHGVAR VAR(&MSG) VALUE('Library' *BCAT &LIB *BCAT 'not found.') GOTO CMDLBL(SNDERRMSG) ENDDO MONMSG MSGID(CPF9801) EXEC(DO) CHGVAR VAR(&MSG) VALUE('Source file' *BCAT &SRCF *BCAT 'not + found.') GOTO CMDLBL(SNDERRMSG) ENDDO MONMSG MSGID(CPF9815) EXEC(DO) CHGVAR VAR(&MSG) VALUE('Member' *BCAT &MBR *BCAT 'not found.') GOTO CMDLBL(SNDERRMSG) ENDDO /* Process source member */ IF COND(&OPTION *EQ '*NEST') THEN(CHGVAR VAR(&MSG) + VALUE('Writing nesting levels. Please wait')) ELSE CMD(CHGVAR VAR(&MSG) VALUE('Clearing columns 1-5. Please + wait')) SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA(&MSG) TOPGMQ(*EXT) + MSGTYPE(*STATUS) OVRDBF FILE(QRPGSRC) TOFILE(&LIB/&SRCF) MBR(&MBR) CALL PGM(RPG001RG) PARM(&OPTION) DLTOVR FILE(*ALL) GOTO CMDLBL(ENDPGM) /* Send error messages */ SNDERRMSG: + SNDPGMMSG MSG(&MSG) MSGTYPE(*DIAG) SNDPGMMSG MSGID(CPF0002) MSGF(QCPFMSG) MSGTYPE(*ESCAPE) /* End program */ ENDPGM: + ENDPGM 
 
 TechTalk: Help with RPG Nesting Levels
 
 Figure 3C RPG program RPG001RG
 
 FQRPGSRC UP F 92 DISK * E D 80 1 * IQRPGSRC NS 01 I 13 92 SRCDTA I DS I 1 80 SRCDTA I 1 80 D I 1 2 LDTABL I 1 5 NEST I 28 32 OPCODE I 28 29 OP2 I 28 30 OP3 * C *ENTRY PLIST C PARM OPTION 6 * * PROCESS RECORDS C LDTABL CASEQ'**' ENDPGM C OPTION CASEQ'*CLEAR' CLEAR C D,6 CASNE'C' CLEAR C D,7 CASEQ'*' CLEAR C D,7 CASEQ'/' CLEAR C OP2 CASEQ'DO' INDENT C OP2 CASEQ'IF' INDENT C OP3 CASEQ'CAS' CASE C OPCODE CASEQ'END' END C OPCODE CASEQ'ELSE' ELSE C CAS LEVEL C END * * SAVE OPCODE, CASXX OPCODES NEED THIS C D,6 IFEQ 'C' C D,7 ANDNE'*' C D,7 ANDNE'/' C MOVE OP3 SVOP3 3 C ELSE C CLEARSVOP3 C END * * END THE PROGRAM EARLY C ENDPGM BEGSR C MOVE '1' *INLR C ENDSR * * CLEAR COLUMNS 1-5 C CLEAR BEGSR C CLEARNEST C ENDSR * * INDENT A LEVEL C INDENT BEGSR C EXSR CLEAR C MOVEL'B' D,1 C ADD 1 NSTLVL 30 C MOVE NSTLVL ALPHA3 3 C MOVEAALPHA3 D,2 C ENDSR * * CASXX OPCODES C CASE BEGSR C SVOP3 CASNE'CAS' INDENT C END C ENDSR * * GO BACK A LEVEL (UNINDENT) C END BEGSR C EXSR CLEAR C MOVEL'E' D,1 C MOVE NSTLVL ALPHA3 C MOVEAALPHA3 D,2 C SUB 1 NSTLVL C ENDSR * * ELSE OPCODE C ELSE BEGSR C MOVEL'*' D,1 C MOVE NSTLVL ALPHA3 C MOVEAALPHA3 D,2 C ENDSR * * PUT NESTING LEVEL ON C-SPEC C LEVEL BEGSR C CLEARNEST C NSTLVL IFNE *ZERO C MOVEL' ' D,1 C MOVE NSTLVL ALPHA3 C MOVEAALPHA3 D,2 C END C ENDSR * OQRPGSRC D 01 O SRCDTA 92