CLP SETGETMSGQ - Handle Message Requests

LANSA

CLP SETGETMSGQ - Handle Message Requests
PGM PARM(&FROMQUEUE &FIRSTNEXT &KEYVAR +
&LEVELONE &MSGID &SEV &SENDER &RTNTYPE)

DCL VAR(&FROMQUEUE) TYPE(*CHAR) LEN(10)
DCL VAR(&FIRSTNEXT) TYPE(*CHAR) LEN(1)

DCL VAR(&KEYVAR) TYPE(*CHAR) LEN(4)
DCL VAR(&LEVELONE) TYPE(*CHAR) LEN(132)
DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
DCL VAR(&SEV) TYPE(*DEC) LEN(2 0)
DCL VAR(&SENDER) TYPE(*CHAR) LEN(80)
DCL VAR(&RTNTYPE) TYPE(*CHAR) LEN(2)

MONMSG MSGID(CPF0000 MCH0000) EXEC(GOTO CMDLBL(END))

/* ============================== */
/* HANDLE A FIRST MESSAGE REQUEST */
/* ============================== */

IF COND(&FIRSTNEXT = 'F') THEN(DO)

CHGVAR VAR(&RTNTYPE) VALUE(' ')

RCVMSG MSGQ(&FROMQUEUE) MSGTYPE(*FIRST) RMV(*NO) +
KEYVAR(&KEYVAR) MSG(&LEVELONE) +
MSGID(&MSGID) +
SEV(&SEV) SENDER(&SENDER) RTNTYPE(&RTNTYPE)
MONMSG MSGID(CPF0000 MCH0000) EXEC(GOTO CMDLBL(END))

GOTO CMDLBL(END)
ENDDO

/* ============================== */
/* HANDLE A NEXT MESSAGE REQUEST */
/* ============================== */

IF COND(&FIRSTNEXT = 'N') THEN(DO)

CHGVAR VAR(&RTNTYPE) VALUE(' ')

RCVMSG MSGQ(&FROMQUEUE) MSGTYPE(*NEXT) +
MSGKEY(&KEYVAR) RMV(*NO) KEYVAR(&KEYVAR) +
MSG(&LEVELONE) +
MSGID(&MSGID) SEV(&SEV) SENDER(&SENDER) +
RTNTYPE(&RTNTYPE)
MONMSG MSGID(CPF0000 MCH0000) EXEC(GOTO CMDLBL(END))

GOTO CMDLBL(END)
ENDDO


/* =============================== */
/* HANDLE A DELETE MESSAGE REQUEST */
/* =============================== */

IF COND(&FIRSTNEXT = 'D') THEN(DO)

CHGVAR VAR(&RTNTYPE) VALUE('OK')

RMVMSG MSGQ(&FROMQUEUE) MSGKEY(&KEYVAR) CLEAR(*BYKEY)
MONMSG MSGID(CPF0000 MCH0000) EXEC(CHGVAR +
VAR(&RTNTYPE) VALUE('ER'))

GOTO CMDLBL(END)
ENDDO


/* =================================== */
/* HANDLE A DELETE ALL MESSAGE REQUEST */
/* =================================== */

IF COND(&FIRSTNEXT = 'U') THEN(DO)

CHGVAR VAR(&RTNTYPE) VALUE('OK')

RMVMSG MSGQ(&FROMQUEUE) CLEAR(*KEEPUNANS)
MONMSG MSGID(CPF0000 MCH0000) EXEC(CHGVAR +
VAR(&RTNTYPE) VALUE('ER'))

GOTO CMDLBL(END)
ENDDO

/* =================================== */
/* HANDLE A DELETE OLD MESSAGE REQUEST */
/* =================================== */

IF COND(&FIRSTNEXT = 'O') THEN(DO)

CHGVAR VAR(&RTNTYPE) VALUE('OK')

RMVMSG MSGQ(&FROMQUEUE) CLEAR(*OLD)
MONMSG MSGID(CPF0000 MCH0000) EXEC(CHGVAR +
VAR(&RTNTYPE) VALUE('ER'))

GOTO CMDLBL(END)
ENDDO

/* ============================== */
/* HANDLE A REPLY MESSAGE REQUEST */
/* ============================== */

IF COND(&FIRSTNEXT = 'R') THEN(DO)

CHGVAR VAR(&RTNTYPE) VALUE('OK')

SNDRPY MSGKEY(&KEYVAR) MSGQ(&FROMQUEUE) +
RPY(&LEVELONE) RMV(*YES)
MONMSG MSGID(CPF0000 MCH0000) EXEC(CHGVAR +
VAR(&RTNTYPE) VALUE('ER'))

GOTO CMDLBL(END)
ENDDO

RETURN
END: ENDPGM