Sorry for the confusion about DSPPGMMSG. It turns out that this was a command added by a conversion utility I had purchased called Target 400. This was a utility that converted OCL to CL and other System 36 stuff to OS/400. I had not realized that it was not part of OS/400.
In checking, I find that I do not have the source code for DSPPGMMSG. However, if you replace it with SNDUSRMSG the CL program MPR will run, just not as nicely as with the DSPPGMMSG command. The corrected code is below, and I'm sure if you play with it a bit you will find an even better way to handle the prompting for parameters.
I have contacted the software company that created Target 400, and if it is willing to release the source code for DSPPGMMSG I will make it available it to you later.
5769PW1 V4R4M0 990521 SEU SOURCE LISTING
01/08/01 19:19:32
SOURCE FILE . . . . . . . DJKLIB/QCLSRC
MEMBER . . . . . . . . . MPR
SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...
+... 7 ...+... 8
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)
Requires Free Membership to View
Register today to access targeted resources from our editorial writers and independent industry experts including news, tips, and advice to help you do your job more efficiently and effectively. Stay informed on the hottest topics and biggest challenges faced by IT professionals working with iSeries products and services.
LEN(1 0)
900
1100 MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(FAIL))
1300 IF COND(&MENU *EQ ' ') THEN(DO)
1400 SNDUSRMSG MSG(' ENTER THE MENU NAME') +
1500 MSGTYPE(*INQ) MSGRPY(&MENU)
1600 ENDDO
1800 IF COND(&ITEM *EQ ' ') THEN(DO)
1900 SNDUSRMSG MSG(' ENTER THE ITEM#') MSGTYPE(*INQ) +
2000 MSGRPY(&ITEM)
2100 ENDDO
2200 IF COND(&LIB *EQ ' ') THEN(DO)
2300 CHGVAR VAR(&LIB) VALUE(JCSLIBR)
2400 ENDDO
2500 CHGDTAARA DTAARA(*LDA (1 49)) VALUE('00000000' || +
2600 &ITEM |< '987654321')
2700 CHGVAR VAR(&X) VALUE(%SST(*LDA 17 1))
2800 CHGDTAARA DTAARA(*LDA (1 8)) VALUE(%SST(*LDA &X 8))
2900 CHGVAR VAR(&ITEM) VALUE(%SST(*LDA 5 4))
3000
3100 RTVMSG MSGID('USR' || &ITEM) MSGF(&LIB/&MENU) +
3200 MSG(&OPTION)
3300
3400 SNDUSRMSG MSG(&OPTION) MSGTYPE(*INFO)
3500 SNDUSRMSG MSG('ENTER THE PROGRAM NAME') MSGTYPE(*INQ)
+
3600 MSGRPY(&PROG)
3700
3800 STRSEU SRCFILE(&LIB/QCLSRC) SRCMBR(&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 * * * *
This was first published in January 2001