This is a very old program, ported from my SYSTEM/38 Days. This
"Bubbles" Up messages and may be the solution to your dilemma.
============ CMD
CMD PROMPT('Bubble Messages Utility')
PARM KWD(PGM) TYPE(*NAME) LEN(10) MIN(1) +
PROMPT('Receive from program:')
PARM KWD(MSGTYPE) TYPE(*CHAR) LEN(10) RSTD(*YES) +
VALUES(*COMP *EXCP) MIN(1) PROMPT('Message +
type:')
PARM KWD(ACTION) TYPE(*CHAR) LEN(10) RSTD(*YES) +
DFT(*BUBBLE) VALUES(*BUBBLE *RECEIVE) +
PROMPT('Action:')
PARM KWD(RCVREL) TYPE(*CHAR) LEN(10) RSTD(*YES) +
DFT(*SAME) VALUES(*SAME *PRV) +
PROMPT('Receive relationship:')
PARM KWD(SNDREL) TYPE(*CHAR) LEN(10) RSTD(*YES) +
DFT(*PRV) VALUES(*PRV *SAME) PROMPT('Send +
relationship:')
PARM KWD(SNDPGM) TYPE(*NAME) LEN(10) DFT(*RCVPGM) +
SPCVAL((*RCVPGM)) PROMPT('Send to program:')
============= CLP
PGM PARM(&RCVPGM &MSGTYPE &ACTION &RCVREL &SNDREL +
&SNDPGM) /* bubble messages utility - cpp */
/* DEFINE VARIABLES */
DCL VAR(&ACTION) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(128)
DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
DCL VAR(&MSGTYPE) TYPE(*CHAR) LEN(10)
DCL VAR(&RCVPGM) TYPE(*CHAR) LEN(10)
DCL VAR(&RCVREL) TYPE(*CHAR) LEN(10)
DCL VAR(&RCVMSGTYPE) TYPE(*CHAR) LEN(10)
DCL VAR(&SNDMSGTYPE) TYPE(*CHAR) LEN(10)
DCL VAR(&SNDPGM) TYPE(*CHAR) LEN(10)
DCL VAR(&SNDREL) TYPE(*CHAR) LEN(10)
MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ENDPGM))
/* INITIALIZE VARIABLES */
IF COND(&MSGTYPE *EQ *COMP) THEN(DO)
CHGVAR VAR(&RCVMSGTYPE) VALUE(*COMP)
CHGVAR VAR(&SNDMSGTYPE) VALUE(*COMP)
ENDDO
ELSE CMD(DO)
CHGVAR VAR(&RCVMSGTYPE) VALUE(*EXCP)
CHGVAR VAR(&SNDMSGTYPE) VALUE(*ESCAPE)
ENDDO
IF COND(&SNDPGM *EQ *RCVPGM) THEN(DO)
CHGVAR VAR(&SNDPGM) VALUE(&RCVPGM)
ENDDO
/* RECEIVE A MESSAGE */
RCVMSG: RCVMSG PGMQ(&RCVREL &RCVPGM) MSGTYPE(&RCVMSGTYPE) +
RMV(*NO) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) MSGFLIB(&MSGFLIB)
/* FIX OS/400 BUG */
IF COND(&MSGF = QRPGMSG) THEN(DO)
CHGVAR VAR(&MSGFLIB) VALUE(QRPG)
ENDDO
IF COND(&MSGF = QRPGLEMSG) THEN(DO)
CHGVAR VAR(&MSGFLIB) VALUE(QRPGLE)
ENDDO
/* IF NO MESSAGE */
IF COND(&MSGID *EQ ' ') THEN(DO)
IF COND(&RCVMSGTYPE *EQ *EXCP) THEN(DO)
CHGVAR VAR(&MSGID) VALUE(CPF1999)
CHGVAR VAR(&MSGF) VALUE(QCPFMSG)
CHGVAR VAR(&MSGFLIB) VALUE(QSYS)
ENDDO
ELSE CMD(GOTO CMDLBL(ENDPGM))
ENDDO
/* LOOP IF ACTION *RECEIVE */
IF COND(&ACTION *EQ *RECEIVE) THEN(GOTO +
CMDLBL(RCVMSG))
/* SEND THE MESSAGE */
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) MSGDTA(&MSGDTA) +
TOPGMQ(&SNDREL &SNDPGM) MSGTYPE(&SNDMSGTYPE)
/* LOOP */
GOTO CMDLBL(RCVMSG)
/* TERMINATE */
ENDPGM: ENDPGM
Thanks,
Gavin Inman
Usage is
On 2/25/2021 7:45 AM, Patrik Schindler wrote:
Hello,
this message stuff really drives me mad. ;-)
I have a program doing just a simple task and ends. I want to display a status message upon program end so the user knows it has run (and optionally displays the content of a counter variable, how many PF rows were affected).
What I've done so far is to be seen in
https://leela.pocnet.net/~poc/BOORDRSTPG.TXT (Yes, it's positional. I'm running V4. I'm a hobbyist, so please refrain from out of scope comments.)
When I run that program, the message shows up briefly and is erased thereafter.
How can I make it stay? What did I miss to understand about the whole call stack business, to be able to send the message to the caller? Eventually this is a user, typing a number according to a menu display which runs CALL PGM(BOORDRSTPG).
Thank you.
:wq! PoC
midrange.com
