Know what's running

Here's an easy way to see what command is executing when you select an item from an AS400 menu. After compiling

the CL program below, you simply key "CALL MPR" from a command line. You will be prompted for the menu name, then the item #. Next, the menu item command will be displayed, and you will be prompted for the program name. At this point you can hit enter, and this will exit the MPR program. Or you can key the displayed command, and if the displayed command is a CL program, the code will be displayed.

In a typical production environment the operator would go to a menu and select an item number to run a report, enter data, do inquiries, etc. When something doesn't work you usually get a call that #12 on the PRODRPT menu is not doing what it should. With this little utility you enter PRODRPT for the menu prompt and 12 for the item# prompt and find that CL program PRODRP1P is called by #12, and if you then enter PRODRP1P for the program name prompt, you will see the actual code for PRODRP1P.

In my code replace the XXXLIB with your library name (see listing below). If you use this on a menu in a library that is different from the one where you compiled MPR, you must key CALL XXXLIB/MPR where XXXMPR is the name of the library where you compiled MPR.

5769PW1 V4R2M0� 980228����������������� SEU SOURCE LISTING��������������������������� 11/14/00 11:11:44 

SOURCE FILE . . . . . . .� XXXLIB/QCLSRC 
MEMBER� . . . . . . . . .� MPR 

SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 
� 100���������������������� PGM 
� 200 
� 300���������������������� DCL������� VAR(&MENU)��� TYPE(*CHAR) LEN(10) 
� 400���������������������� DCL������� VAR(&ITEM)��� TYPE(*CHAR) LEN(10) 
� 500���������������������� DCL������� VAR(&LIB)��� TYPE(*CHAR) LEN(10) 
� 600���������������������� DCL������� VAR(&PROG)��� TYPE(*CHAR) LEN(10) 
� 700���������������������� DCL������� VAR(&OPTION)� TYPE(*CHAR) LEN(50) 
� 800���������������������� DCL������� VAR(&X)������ TYPE(*DEC) LEN(1 0) 
� 900 
�1100���������������������� MONMSG���� MSGID(CPF0000) EXEC(GOTO CMDLBL(FAIL)) 
�1300���������������������� IF�������� COND(&MENU *EQ ' ') THEN(DO) 
�1400���������������������� DSPPGMMSG� MSG(' ENTER THE MENU NAME') MSGTYPE(*INQ) + 
�1500���������������������� MSGRPY(&MENU) CLEAR(*YES) 
�1600���������������������� ENDDO 
�1800���������������������� IF�������� COND(&ITEM *EQ ' ') THEN(DO) 
�1900���������������������� DSPPGMMSG� MSG(' ENTER THE ITEM#') MSGTYPE(*INQ) + 
�2000��������������������������������� MSGRPY(&ITEM) 
�2100���������������������� ENDDO 
�2200���������������������� IF�������� COND(&LIB *EQ ' ')� THEN(DO) 
�2300���������������������� CHGVAR���� VAR(&LIB) VALUE(XXXLIB)����� 
�2400���������������������� ENDDO 
�2500���������������������� CHGDTAARA� DTAARA(*LDA (1 49)) VALUE('00000000' || + 
�2600��������������������������������� &amp;amp;amp;ITEM |< '987654321') 
�2700���������������������� CHGVAR���� VAR(&amp;amp;amp;X) VALUE(%SST(*LDA 17 1)) 
�2800���������������������� CHGDTAARA� DTAARA(*LDA (1 8)) VALUE(%SST(*LDA &amp;amp;amp;X 8)) 
�2900���������������������� CHGVAR���� VAR(&amp;amp;amp;ITEM) VALUE(%SST(*LDA 5 4)) 
�3000 
�3100���������������������� RTVMSG���� MSGID('USR' || &amp;amp;amp;ITEM) MSGF(&amp;amp;amp;LIB/&amp;amp;amp;MENU) + 
�3200��������������������������������� MSG(&amp;amp;amp;OPTION) 
�3300 
�3400���������������������� DSPPGMMSG� MSG(&amp;amp;amp;OPTION) 
�3500���������������������� DSPPGMMSG� MSG('ENTER THE PROGRAM NAME') MSGTYPE(*INQ) + 
�3600��������������������������������� MSGRPY(&amp;amp;amp;PROG) 
�3700 
�3800���������������������� STRSEU���� SRCFILE(&amp;amp;amp;LIB/QCLSRC) SRCMBR(&amp;amp;amp;PROG) OPTION(5) 
�3900���������������������� GOTO������ CMDLBL(END) 
�4000��������� FAIL:������� DSPPGMMSG� MSG('FAILED') 
�4100��������� END:�������� ENDPGM 


* * * *� E N D� O F� S O U R C E� * * * * 

********************************
About the author: Joe Koepnick has been Controller at J. C. Steele and Sons Inc. for 20 years, and he has worked with IBM midrange systems since the System 32 days.

********************************
Reader feedback:

From Tom Liota
AS/400 Systems Programmer
The PowerTech Group, Inc. :

Four comments to make tips more useful to your readers:

1. The source for DSPPGMMSG (or a way to get it) should be included since it is used in your published code, otherwise DSPPGMMSG should be replaced with SNDUSRMSG or another appropriate command. This will save your readers from searching for a command that is not generally available.

2. The concatenation operators might be better replaced with '*CAT' and '*TCAT' in statement 2500 and with '*CAT' in statement 3100. Although the different representations work as well, readers with different character sets might find the spelled-out versions easier to work with.

3. It should be noted that this utility will only work with SDA menus. Other forms of AS/400 menus, either pure display file or UIM, will give incorrect results or cause a 'FAILED' message.

4. The technique at statements 2500-2900 for determining the number of significant characters in the variable &amp;amp;ITEM is interesting, but I'd suggest changing away from using the *LDA local data area to a simple local variable or some other object such as a program-temporary data area. By changing *LDA, the program could conceivably change values used by other steps in the job.


This was first published in January 2001

Dig deeper on RPG iSeries programming

0 comments

Oldest 

Forgot Password?

No problem! Submit your e-mail address below. We'll send you an email containing your password.

Your password has been sent to:

SearchEnterpriseLinux

SearchDataCenter

Close