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:
  1. /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
  2. /* *                                                               * */
  3. /* * *       Request Processor                                   * * */
  4. /* *                                                               * */
  5. /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
  6.  PGM
  7.  
  8.     DCL        VAR(&USER      ) TYPE(*CHAR) LEN(  10)
  9.     DCL        VAR(&MSGKEY    ) TYPE(*CHAR) LEN(   7)
  10.     DCL        VAR(&KEYVAR    ) TYPE(*CHAR) LEN(   7)
  11.     DCL        VAR(&MSG       ) TYPE(*CHAR) LEN(2048)
  12.     DCL        VAR(&CMDLEN    ) TYPE(*DEC ) LEN(15 5) VALUE(2048)
  13.     DCL        VAR(&RTNTYPE   ) TYPE(*CHAR) LEN(   2)
  14.     DCL        VAR(&LOG       ) TYPE(*LGL ) LEN(   1) VALUE('1')
  15.  
  16.        CHGJOB     PRTTXT(*BLANK) LOGCLPGM(*NO)
  17.        RMVMSG     CLEAR(*ALL)
  18.  
  19. TAG2:  SNDPGMMSG  MSG('I am a request processor!') TOPGMQ(*EXT) MSGTYPE(*RQS)
  20.        RCVMSG     PGMQ(*EXT) MSGTYPE(*RQS) RMV(*NO)
  21.  
  22. TAG1:  RCVMSG     PGMQ(*EXT) MSGTYPE(*RQS) RMV(*NO) +
  23.                   KEYVAR(&MSGKEY) MSG(&MSG) RTNTYPE(&RTNTYPE)
  24.        MONMSG     MSGID(CPF2415) EXEC(DO)
  25.           RCVMSG     MSGTYPE(*EXCP)
  26.           GOTO       CMDLBL(TAG1)
  27.        ENDDO
  28.  
  29.        IF         COND(&MSG = 'ENDRQS' *OR &MSG = 'endrqs') THEN(DO) /* who says programmers */
  30.           SNDPGMMSG  MSGID(CPF1037) MSGF(QCPFMSG) TOPGMQ(*SAME)      /* don't have a sense   */
  31.           GOTO       CMDLBL(TAG1)                                    /* of humor             */
  32.        ENDDO
  33.  
  34.        IF         COND(&MSG = 'eoj') THEN(GOTO CMDLBL(EOJ))
  35.  
  36.        IF         COND(&MSG = 'log') THEN(DO)
  37.           RMVMSG     PGMQ(*EXT) MSGKEY(&MSGKEY)
  38.           IF         COND(&LOG) THEN(CHGVAR VAR(&LOG) VALUE('0'        ))
  39.           ELSE       CMD(CHGVAR VAR(&LOG) VALUE('1'))
  40.           GOTO       CMDLBL(TAG1)
  41.        ENDDO
  42.  
  43.        IF         COND(&MSG = 'soundout') THEN(DO)
  44.           RMVMSG     PGMQ(*EXT) MSGKEY(&MSGKEY)
  45.           SNDPGMMSG  MSG('I am a request processor! v3.141579') TOPGMQ(*EXT) MSGTYPE(*RQS)
  46.           RCVMSG     PGMQ(*EXT) MSGTYPE(*RQS) RMV(*NO)
  47.           GOTO       CMDLBL(TAG1)
  48.        ENDDO
  49.  
  50.        IF         COND(&MSG = 'clrlog') THEN(DO)
  51.           RMVMSG     PGMQ(*EXT)      CLEAR(*ALL)
  52.           RMVMSG     PGMQ(*SAME)     CLEAR(*ALL)
  53.           RMVMSG     PGMQ(*ALLINACT) CLEAR(*ALL)
  54.           GOTO       CMDLBL(TAG2)
  55.        ENDDO
  56.  
  57.        IF         COND(&RTNTYPE = '10') THEN(DO)
  58.           IF         COND(%SST(&MSG 1 1) *NE '?') THEN( +
  59.              CHGVAR VAR(&MSG) VALUE('?' *CAT &MSG))
  60.           CALL       PGM(QCMDCHK) PARM(&MSG &CMDLEN)
  61.           MONMSG     MSGID(CPF0000) EXEC(DO)
  62.              IF         COND(&LOG) THEN(GOTO CMDLBL(TAG1))
  63.              ELSE       CMD(GOTO CMDLBL(TAG4))
  64.           ENDDO
  65.           RMVMSG     PGMQ(*EXT) MSGKEY(&MSGKEY)
  66.           SNDPGMMSG  MSG(&MSG) TOPGMQ(*EXT) MSGTYPE(*RQS)
  67.           RCVMSG     PGMQ(*EXT) MSGTYPE(*RQS) RMV(*NO) +
  68.                      KEYVAR(&MSGKEY)
  69.        ENDDO
  70.  
  71.  
  72.        IF         COND(&LOG) THEN(GOTO CMDLBL(TAG3))
  73.  
  74.        RMVMSG     PGMQ(*EXT) MSGKEY(&MSGKEY)
  75.  
  76. TAG3:  CALL       PGM(QCMDEXC) PARM(&MSG &CMDLEN)
  77.        MONMSG     MSGID(CPF0000)
  78.  
  79.  
  80.        IF         COND(&LOG) THEN(GOTO CMDLBL(TAG1))
  81.  
  82. TAG4:  RCVMSG     MSGTYPE(*DIAG)
  83.        IF         COND(&KEYVAR *NE '       ') THEN(GOTO CMDLBL(TAG4))
  84.        RCVMSG     MSGTYPE(*EXCP)
  85.  
  86.        GOTO       CMDLBL(TAG1)
  87.  
  88. EOJ: ENDPGM
  89.  
© 2004-2019 by midrange.com generated in 0.004s valid xhtml & css