midrange.com code scratchpad |
Name:
midrange01
|
Scriptlanguage:
Plain Text
|
Tabwidth:
4
|
Date:
08/29/2016 06:28:14 pm
|
IP:
Logged
|
|
Description:
A simple request processor, used as the skeleton for a QCMD replacement
|
Code:
- /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
- /* * * */
- /* * * Request Processor * * */
- /* * * */
- /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
- PGM
-
- DCL VAR(&USER ) TYPE(*CHAR) LEN( 10)
- DCL VAR(&MSGKEY ) TYPE(*CHAR) LEN( 7)
- DCL VAR(&KEYVAR ) TYPE(*CHAR) LEN( 7)
- DCL VAR(&MSG ) TYPE(*CHAR) LEN(2048)
- DCL VAR(&CMDLEN ) TYPE(*DEC ) LEN(15 5) VALUE(2048)
- DCL VAR(&RTNTYPE ) TYPE(*CHAR) LEN( 2)
- DCL VAR(&LOG ) TYPE(*LGL ) LEN( 1) VALUE('1')
-
- CHGJOB PRTTXT(*BLANK) LOGCLPGM(*NO)
- RMVMSG CLEAR(*ALL)
-
- TAG2: SNDPGMMSG MSG('I am a request processor!') TOPGMQ(*EXT) MSGTYPE(*RQS)
- RCVMSG PGMQ(*EXT) MSGTYPE(*RQS) RMV(*NO)
-
- TAG1: RCVMSG PGMQ(*EXT) MSGTYPE(*RQS) RMV(*NO) +
- KEYVAR(&MSGKEY) MSG(&MSG) RTNTYPE(&RTNTYPE)
- MONMSG MSGID(CPF2415) EXEC(DO)
- RCVMSG MSGTYPE(*EXCP)
- GOTO CMDLBL(TAG1)
- ENDDO
-
- IF COND(&MSG = 'ENDRQS' *OR &MSG = 'endrqs') THEN(DO) /* who says programmers */
- SNDPGMMSG MSGID(CPF1037) MSGF(QCPFMSG) TOPGMQ(*SAME) /* don't have a sense */
- GOTO CMDLBL(TAG1) /* of humor */
- ENDDO
-
- IF COND(&MSG = 'eoj') THEN(GOTO CMDLBL(EOJ))
-
- IF COND(&MSG = 'log') THEN(DO)
- RMVMSG PGMQ(*EXT) MSGKEY(&MSGKEY)
- IF COND(&LOG) THEN(CHGVAR VAR(&LOG) VALUE('0' ))
- ELSE CMD(CHGVAR VAR(&LOG) VALUE('1'))
- GOTO CMDLBL(TAG1)
- ENDDO
-
- IF COND(&MSG = 'soundout') THEN(DO)
- RMVMSG PGMQ(*EXT) MSGKEY(&MSGKEY)
- SNDPGMMSG MSG('I am a request processor! v3.141579') TOPGMQ(*EXT) MSGTYPE(*RQS)
- RCVMSG PGMQ(*EXT) MSGTYPE(*RQS) RMV(*NO)
- GOTO CMDLBL(TAG1)
- ENDDO
-
- IF COND(&MSG = 'clrlog') THEN(DO)
- RMVMSG PGMQ(*EXT) CLEAR(*ALL)
- RMVMSG PGMQ(*SAME) CLEAR(*ALL)
- RMVMSG PGMQ(*ALLINACT) CLEAR(*ALL)
- GOTO CMDLBL(TAG2)
- ENDDO
-
- IF COND(&RTNTYPE = '10') THEN(DO)
- IF COND(%SST(&MSG 1 1) *NE '?') THEN( +
- CHGVAR VAR(&MSG) VALUE('?' *CAT &MSG))
- CALL PGM(QCMDCHK) PARM(&MSG &CMDLEN)
- MONMSG MSGID(CPF0000) EXEC(DO)
- IF COND(&LOG) THEN(GOTO CMDLBL(TAG1))
- ELSE CMD(GOTO CMDLBL(TAG4))
- ENDDO
- RMVMSG PGMQ(*EXT) MSGKEY(&MSGKEY)
- SNDPGMMSG MSG(&MSG) TOPGMQ(*EXT) MSGTYPE(*RQS)
- RCVMSG PGMQ(*EXT) MSGTYPE(*RQS) RMV(*NO) +
- KEYVAR(&MSGKEY)
- ENDDO
-
-
- IF COND(&LOG) THEN(GOTO CMDLBL(TAG3))
-
- RMVMSG PGMQ(*EXT) MSGKEY(&MSGKEY)
-
- TAG3: CALL PGM(QCMDEXC) PARM(&MSG &CMDLEN)
- MONMSG MSGID(CPF0000)
-
-
- IF COND(&LOG) THEN(GOTO CMDLBL(TAG1))
-
- TAG4: RCVMSG MSGTYPE(*DIAG)
- IF COND(&KEYVAR *NE ' ') THEN(GOTO CMDLBL(TAG4))
- RCVMSG MSGTYPE(*EXCP)
-
- GOTO CMDLBL(TAG1)
-
- EOJ: ENDPGM
-
|
|
|