midrange.com code scratchpad
Name:
Alan Campin
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
09/10/2014 03:20:13 pm
IP:
Logged
Description:
Module that demonstrates using STRQMQRY with variables.
Code:
  1. /*   ‚*_> CNLLSTSPLF SRCFILE(@2/@1) SRCMBR(@3)                               */
  2. /*‚   *_> DLTMOD MODULE(@5/@4)                                               */
  3. /*‚   *_> CRTCLMOD MODULE(@5/@4) SRCFILE(@2/@1) SRCMBR(@3) +                 */
  4. /*‚   *_>   DBGVIEW(@9) OPTIMIZE(@8) OPTION(*EVENTF)                         */
  5. /*‚   *----------------------------------------------------------------------*/
  6. /*‚   * Module.: XV0001_M01          Project.....:                           */
  7. /*‚   * Author.: A. Campin           Date written: 10/14/2004                */
  8. /*‚   * Purpose: Build physical file with job log records, call an           */
  9. /*‚   *            RPGILE module to extract records and run QM to            */
  10. /*‚   *            produce the report.                                       */
  11. /*‚   *--------------------------------------------------------------------- */
  12. /*‚   * Called by: XTREXPMSG                                                 */
  13. /*‚   *--------------------------------------------------------------------- */
  14. /*‚   * Revision history:                                                    */
  15. /*‚   *  Proj#  Pgmr         Date    Desc                                    */
  16. /*‚   *                                                                      */
  17. /*‚   * End Revision History                                                 */
  18. /*‚   *--------------------------------------------------------------------- */
  19.              PGM        PARM(&JOB &SEVERITY &SAVE &HOLD &OUTPUT)
  20.  
  21.              DCL        VAR(&JOB) TYPE(*CHAR) LEN(26) /* Qualified +
  22.                           Job Name or * for current job. */
  23.              DCL        VAR(&SEVERITY) TYPE(*DEC) LEN(2 0) /* +
  24.                           Message Severity equal to or above +
  25.                           extract. */
  26.              DCL        VAR(&SAVE) TYPE(*CHAR) LEN(1) /* Save Spool +
  27.                           File *YES(Y) or *NO(N). */
  28.              DCL        VAR(&HOLD) TYPE(*CHAR) LEN(1) /* Hold Spool +
  29.                           File *YES(Y) or *NO(N) */
  30.              DCL        VAR(&OUTPUT) TYPE(*CHAR) LEN(20) /* +
  31.                           Qualified Output Queue Name. *JOB, *DEV +
  32.                           Single Value. */
  33.  
  34.              DCL        VAR(&QUOTE) TYPE(*CHAR) LEN(1) VALUE('''')
  35.              DCL        VAR(&JOBNAME) TYPE(*CHAR) LEN(10)
  36.              DCL        VAR(&USERNAME) TYPE(*CHAR) LEN(10)
  37.              DCL        VAR(&JOBNUMBER) TYPE(*CHAR) LEN(6)
  38.  
  39.              DCL        VAR(&QNAME) TYPE(*CHAR) LEN(10)
  40.              DCL        VAR(&QLIB) TYPE(*CHAR) LEN(10)
  41.  
  42.              DCL        VAR(&RTNLIB) TYPE(*CHAR) LEN(10)
  43.              DCL        VAR(&JOBACTIVE) TYPE(*CHAR) LEN(1)
  44.  
  45.              DCL        VAR(&HOLD_CHR) TYPE(*CHAR) LEN(4) VALUE('*NO ')
  46.              DCL        VAR(&SAVE_CHR) TYPE(*CHAR) LEN(4) VALUE('*NO ')
  47.              DCL        VAR(&SEV_CHR) TYPE(*CHAR) LEN(2)
  48.  
  49.              DCL        VAR(&MSGID) TYPE(*CHAR) LEN(7)
  50.              DCL        VAR(&MSGF) TYPE(*CHAR) LEN(10)
  51.              DCL        VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)
  52.              DCL        VAR(&MSGDTA) TYPE(*CHAR) LEN(256)
  53.  
  54.              MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(HANDLE_ERR))
  55.  
  56.              IF         COND(&JOB *EQ '*') THEN(DO)
  57.                RTVJOBA    JOB(&JOBNAME) USER(&USERNAME) NBR(&JOBNUMBER)
  58.              ENDDO
  59.              ELSE       CMD(DO)
  60.                CHGVAR     VAR(&JOBNAME) VALUE(%SST(&JOB 1 10))
  61.                CHGVAR     VAR(&USERNAME) VALUE(%SST(&JOB 11 10))
  62.                CHGVAR     VAR(&JOBNUMBER) VALUE(%SST(&JOB 21 6))
  63.              ENDDO
  64.  
  65.  
  66.              DLTF       FILE(QTEMP/JLTEMP)
  67.              MONMSG     MSGID(CPF0000)
  68.  
  69.              CRTPF      FILE(QTEMP/JLTEMP) RCDLEN(133) TEXT('Temp to +
  70.                           hold spool records') SIZE(10000 1000 499) +
  71.                           AUT(*ALL)
  72.  
  73.              OVRPRTF    FILE(QPJOBLOG) HOLD(*YES)
  74.  
  75.              CHGVAR     VAR(&JOBACTIVE) VALUE('Y')
  76.              DSPJOBLOG  JOB(&JOBNUMBER/&USERNAME/&JOBNAME) +
  77.                           OUTPUT(*PRINT)
  78.              MONMSG     MSGID(CPF2443 CPF2441) EXEC(DO)
  79.                CHGVAR     VAR(&JOBACTIVE) VALUE('N')
  80.              ENDDO
  81.              IF         COND(&JOBACTIVE *EQ 'N') THEN(DO)
  82.                CPYSPLF    FILE(QPJOBLOG) TOFILE(QTEMP/JLTEMP) +
  83.                             JOB(&JOBNUMBER/&USERNAME/&JOBNAME) +
  84.                             SPLNBR(*LAST) CTLCHAR(*FCFC)
  85.              ENDDO
  86.              ELSE       CMD(DO)
  87.                CPYSPLF    FILE(QPJOBLOG) TOFILE(QTEMP/JLTEMP) JOB(*) +
  88.                             SPLNBR(*LAST) CTLCHAR(*FCFC)
  89.                DLTSPLF    FILE(QPJOBLOG) JOB(*) SPLNBR(*LAST)
  90.              ENDDO
  91.  
  92.              DLTOVR     FILE(*ALL)
  93.  
  94.              DLTF       FILE(QTEMP/XV0001_T01)
  95.              MONMSG     MSGID(CPF0000)
  96.  
  97.              RTVOBJD    OBJ(XV0001_T01) OBJTYPE(*FILE) RTNLIB(&RTNLIB)
  98.              CRTDUPOBJ  OBJ(XV0001_T01) FROMLIB(&RTNLIB) +
  99.                           OBJTYPE(*FILE) TOLIB(QTEMP) +
  100.                           NEWOBJ(XV0001_T01)
  101.              GRTOBJAUT  OBJ(QTEMP/XV0001_T01) OBJTYPE(*FILE) +
  102.                           USER(*PUBLIC) AUT(*ALL)
  103.  
  104.              OVRDBF     FILE(JLTEMP) TOFILE(QTEMP/JLTEMP) +
  105.                           SHARE(*YES) SEQONLY(*YES 100)
  106.              OVRDBF     FILE(XV0001_T01) TOFILE(QTEMP/XV0001_T01) +
  107.                           SHARE(*YES) SEQONLY(*YES 100)
  108.  
  109.              CALLPRC    PRC('ExtractRecords') PARM(&SEVERITY)
  110.  
  111.              IF         COND(&SAVE *EQ 'Y') THEN(CHGVAR +
  112.                           VAR(&SAVE_CHR) VALUE('*YES'))
  113.  
  114.              IF         COND(&HOLD *EQ 'Y') THEN(CHGVAR +
  115.                           VAR(&HOLD_CHR) VALUE('*YES'))
  116.  
  117.              CHGVAR     VAR(&SEV_CHR) VALUE(&SEVERITY)
  118.  
  119.              CHGVAR     VAR(&QNAME) VALUE(%SST(&OUTPUT 1 10))
  120.              CHGVAR     VAR(&QLIB) VALUE(%SST(&OUTPUT 11 10))
  121.              IF         COND((&QNAME *EQ '*JOB') *OR (&QNAME *EQ +
  122.                           '*DEV')) THEN(DO)
  123.                OVRPRTF    FILE(QPQXPRTF) PAGESIZE(46 165) LPI(6) +
  124.                             CPI(15) OVRFLW(42) PAGRTT(90) SPOOL(*YES) +
  125.                             OUTQ(&QNAME) FORMTYPE(*STD) +
  126.                             HOLD(&HOLD_CHR) SAVE(&SAVE_CHR) +
  127.                             USRDTA('Exp_List') SPLFNAME(XV0001_P01) +
  128.                             OVRSCOPE(*JOB) SHARE(*YES) OPNSCOPE(*JOB)
  129.              ENDDO
  130.              ELSE       CMD(DO)
  131.                OVRPRTF    FILE(QPQXPRTF) PAGESIZE(46 165) LPI(6) +
  132.                             CPI(15) OVRFLW(42) PAGRTT(90) SPOOL(*YES) +
  133.                             OUTQ(&QLIB/&QNAME) FORMTYPE(*STD) +
  134.                             HOLD(&HOLD_CHR) SAVE(&SAVE_CHR) +
  135.                             USRDTA('Exp_List') SPLFNAME(XV0001_P01) +
  136.                             OVRSCOPE(*JOB) SHARE(*YES) OPNSCOPE(*JOB)
  137.              ENDDO
  138.              STRQMQRY   QMQRY(XV0001_Q01) OUTPUT(*PRINT) +
  139.                           QMFORM(XV0001_Q01) DATETIME(*NO) +
  140.                           PAGNBR(*NO) SETVAR((JOBNAM (&QUOTE || +
  141.                           &JOBNAME || &QUOTE)) (USRNAM (&QUOTE || +
  142.                           &USERNAME || &QUOTE)) (JOBNUM (&QUOTE || +
  143.                           &JOBNUMBER || &QUOTE)) (SEVERITY (&QUOTE +
  144.                           || &SEV_CHR || &QUOTE)))
  145.  
  146.              DLTOVR     FILE(*ALL)
  147.  
  148.              DLTF       FILE(QTEMP/JLTEMP)
  149.              MONMSG     MSGID(CPF0000)
  150.  
  151.              DLTF       FILE(QTEMP/XV0001_T01)
  152.              MONMSG     MSGID(CPF0000)
  153.  
  154.              RETURN
  155. /*------------------------------------------------------------------*/
  156. /* Handle unmonitored errors.                                       */
  157.  
  158. HANDLE_ERR:
  159.              RCVMSG     MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) +
  160.                           MSGF(&MSGF) MSGFLIB(&MSGFLIB)
  161.              MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(END_ABNORM))
  162.              IF         COND(&MSGID *EQ ' ') THEN(GOTO +
  163.                           CMDLBL(END_ABNORM))
  164.              SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
  165.                           MSGDTA(&MSGDTA) MSGTYPE(*DIAG)
  166. END_ABNORM:
  167.  
  168.              SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Command +
  169.                           XTREXPMSG ended abnormally! See previous +
  170.                           messages for reason!') MSGTYPE(*ESCAPE)
  171.  
  172.              ENDPGM
  173.  
© 2004-2019 by midrange.com generated in 0.008s valid xhtml & css