home *** CD-ROM | disk | FTP | other *** search
/ Hall of Fame / HallofFameCDROM.cdr / 3x400 / cpyform.lzh / CPYFORM.EXE / arc / CPYFORM.CLP next >
Text File  |  1987-07-13  |  10KB  |  235 lines
  1. /*  CPP for CPYFORM "Copy Formtype" Command  in JSYSSRC library.              */
  2. /*                                                                            */
  3. /*        See also:  CPYFORMR in QRPGSRC.JSYSSRC                              */
  4. /*                                                                            */
  5. /* Written by:  Philip R. Widing                                              */
  6. /*              Jarl Extrusions, Inc.                                         */
  7. /*              Elizabethton, TN 37644-0871                                   */
  8. /*              615-543-3561                                                  */
  9. /*                                                                            */
  10. /*  01  PRW  87-02-16  First pass...                                          */
  11. /*  02  PRW  87-02-17  handle 100 spool files; send status message            */
  12. /*  03  PRW  87-02-17  Add MONMSG CPF3344                                     */
  13. /*  04  PRW  87-02-18  Add MONMSG CPF3344 ON DSPSPLFA CMD                     */
  14. /*  05  PRW  87-07-13  Use *DTAQ to receive SPLF values...                    */
  15. /*                     Use *JOB OUTQ as default !                             */
  16.  
  17.           PGM         (&QOUTQ  &FORMTYPE &QFILE &MBR &MBROPT +
  18.                        &CNLSPLF  &PRTATR )
  19.  
  20.           DCL         &QOUTQ         *CHAR     20
  21.           DCL         &FORMTYPE      *CHAR     10
  22.           DCL         &QFILE         *CHAR     20
  23.           DCL         &MBR           *CHAR     10
  24.           DCL         &MBROPT        *CHAR      8
  25.           DCL         &CNLSPLF       *CHAR      4
  26.           DCL         &PRTATR        *CHAR      6
  27.  
  28.           DCL         &OUTQ          *CHAR     10
  29.           DCL         &OUTQLIB       *CHAR     10
  30.           DCL         &FILE          *CHAR     10
  31.           DCL         &LIBR          *CHAR     10
  32.           DCL         &JOBN          *CHAR      6
  33.           DCL         &JOUTQ         *CHAR     10
  34.           DCL         &JOUTQLIB      *CHAR     10
  35.           DCL         &COUNT         *DEC    ( 15 5)
  36.           DCL         &COUNT50       *DEC    (  5 0)
  37.           DCL         &COUNT$        *CHAR      5
  38.           DCL         &X             *DEC    (  5 0)
  39.           DCL         &Y             *DEC    (  5 0)
  40.           DCL         &Z             *DEC    (  5 0)
  41.           DCL         &L_PRT         *LGL    (  1  )
  42.           DCL         &L_ALL         *LGL    (  1  )
  43.           DCL         &TRUE          *LGL    (  1  )  '1'
  44.           DCL         &FALSE         *LGL    (  1  )  '0'
  45.  
  46.        /*  Data Queue Variables */
  47.           DCL         &QNAME         *CHAR     10    'DTAQ128'
  48.           DCL         &QLIB          *CHAR     10    'QTEMP'
  49.           DCL         &QRECV         *DEC    (  5 0)  0
  50.           DCL         &QDATA         *CHAR    128    ' '
  51.           DCL         &QWAIT         *DEC    (  5 0)  0
  52.  
  53.        /* Data Queue Content Variables */
  54.           DCL         &SPLFILE       *CHAR     10
  55.           DCL         &SPLNBR        *CHAR      4
  56.           DCL         &SPLJOB        *CHAR     10
  57.           DCL         &SPLUSR        *CHAR     10
  58.           DCL         &SPLJBN        *CHAR      6
  59.  
  60.           DCL         &ERRMSGID      *CHAR      7
  61.           DCL         &MSGDTA        *CHAR    100
  62.           MONMSG      MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
  63.                       /*  ANY ERROR NOT MONITORED FOR */
  64.  
  65.           RTVJOBA     NBR( &JOBN ) OUTQ(&JOUTQ) OUTQLIB(&JOUTQLIB)
  66.  
  67.           CHGVAR      &OUTQ     %SST(&QOUTQ  1 10 )
  68.           CHGVAR      &OUTQLIB  %SST(&QOUTQ 11 10 )
  69.           IF          (&OUTQ *EQ *JOB) THEN( DO )
  70. /* 1 */   CHGVAR      &OUTQ       &JOUTQ
  71.           CHGVAR      &OUTQLIB    &JOUTQLIB
  72. /* 1 */   ENDDO
  73.  
  74.           CHGVAR      &FILE     %SST(&QFILE  1 10 )
  75.           CHGVAR      &LIBR     %SST(&QFILE 11 10 )
  76.  
  77.           IF          (&PRTATR = *YES)  CHGVAR &PRTATR *FIRST
  78.           IF         ((&PRTATR = *FIRST) *OR (&PRTATR = *ALL)) +
  79.             CHGVAR     &L_PRT  &TRUE
  80.           IF          (&PRTATR = *ALL)  +
  81.             CHGVAR     &L_ALL  &TRUE
  82.  
  83.           IF          (&MBR = *FILE) +
  84.             CHGVAR      &MBR      &FILE
  85.  
  86. BEGIN:
  87.           OVRPRTF     QPrtSplQ  HOLD(*YES) SECURE(*YES)
  88.           DSPOUTQ     OUTQ(&OUTQ.&OUTQLIB)  OUTPUT(*LIST)
  89.  
  90.           CPYSPLF     FILE(QPRTSPLQ)  TOFILE(&FILE.&LIBR) +
  91.                       JOB(*) SPLNBR(*LAST) +
  92.                       TOMBR(JN *CAT &JOBN) MBROPT(*REPLACE) +
  93.                       CTLCHAR(*FCFC)
  94.  
  95.           CNLSPLF     FILE(QPRTSPLQ) JOB(*) SPLNBR(*LAST)
  96. CRT_DTAQ:
  97.           CRTDTAQ     &QNAME.&QLIB MAXLEN(128) SEQ(*FIFO) +
  98.                          TEXT('INTRAJOB DTAQ')
  99.           MONMSG      CPF9870    EXEC( DO )  /* ALREADY EXISTS */
  100. /* 1 */   /*  ENSURE *DTAQ IS EMPTY ! */
  101.           CHGVAR      &QWAIT      0
  102. CLR_DTAQ:
  103.           CALL        QRCVDTAQ  +
  104.             PARM(        &QNAME   +
  105.                          &QLIB    +
  106.                          &QRECV   +
  107.                          &QDATA   +
  108.                          &QWAIT   )
  109.           IF          (&QRECV *NE 0) THEN(  GOTO CLR_DTAQ )
  110. /* 1 */   ENDDO
  111.  
  112.           CHGVAR      &COUNT      0
  113.           OVRDBF      FILE(DSPOUTQ) TOFILE(&FILE.&LIBR) MBR(JN *CAT +
  114.                           &JOBN) NBRRCDS(20) SEQONLY(*YES 20)
  115.           CALL        PGM(CPYFORMR) PARM(&FORMTYPE &COUNT)
  116. /*                                                                            */
  117. /*  The call above reads the outq listing and prepares the list of            */
  118. /*  spool files to load into the data base file.                              */
  119. /*                                                                            */
  120.           RMVM        &FILE.&LIBR  MBR(JN *CAT &JOBN)
  121.  
  122.           CHGVAR      &X          0
  123.           CHGVAR      &QWAIT      0
  124. LOOP:     CHGVAR      &X          (&X+1)
  125.           IF         (&X *GT &COUNT) THEN( GOTO EXIT_LOOP )
  126.  
  127.           CALL        QRCVDTAQ  +
  128.             PARM(        &QNAME   +
  129.                          &QLIB    +
  130.                          &QRECV   +
  131.                          &QDATA   +
  132.                          &QWAIT   )
  133.  
  134.           IF          (&QRECV *EQ 0) THEN( GOTO EXIT_LOOP )
  135.  
  136.           CHGVAR      &SPLFILE  %SST(&QDATA  1 10)
  137.           CHGVAR      &SPLNBR   %SST(&QDATA 11  4)
  138.           CHGVAR      &SPLJOB   %SST(&QDATA 15 10)
  139.           CHGVAR      &SPLUSR   %SST(&QDATA 25 10)
  140.           CHGVAR      &SPLJBN   %SST(&QDATA 35  6)
  141.  
  142.           CHGVAR      &COUNT50       &X
  143.           CHGVAR      &COUNT$        &COUNT50
  144.           CHGVAR      &Y             1
  145. ZSUP1:
  146.           IF          ((&Y *GT 4) *OR (%SST(&COUNT$ &Y 1) *NE '0')) +
  147.              GOTO SEND_STS
  148.           CHGVAR      &Y            (&Y+1)
  149.           GOTO        ZSUP1
  150. SEND_STS:
  151.           CHGVAR      &Z            (6-&Y)
  152.           SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA( +
  153.                %SST(&COUNT$ &Y &Z) +
  154.                *CAT '. Copying ' *CAT &SPLFILE *TCAT '.' *CAT +
  155.                &SPLNBR *CAT ', ' *CAT &SPLJOB *TCAT '.' +
  156.                *CAT &SPLUSR *TCAT '.' *CAT &SPLJBN *CAT ', to ' *CAT +
  157.                &FILE *TCAT '.' *CAT &LIBR *TCAT ', Mbr ' *CAT &MBR ) +
  158.                           MSGTYPE(*STATUS) TOPGMQ(*EXT)
  159.  
  160.           CPYSPLF     FILE(&SPLFILE) JOB(&SPLJOB.&SPLUSR.&SPLJBN) +
  161.                       SPLNBR(&SPLNBR) TOFILE(&FILE.&LIBR) +
  162.                       TOMBR(&MBR) MBROPT(&MBROPT) CTLCHAR(*FCFC)
  163. /* 1 */   MONMSG      MSGID( CPF3309 CPF3342 CPF3344 ) EXEC(DO)
  164.           GOTO        CPF3300
  165. /* 1 */   ENDDO
  166.  
  167. /* 1 */   IF          (&L_PRT) THEN( DO )
  168.           DSPSPLFA    FILE(&SPLFILE) +
  169.                       JOB(&SPLJOB.&SPLUSR.&SPLJBN) +
  170.                       SPLNBR(&SPLNBR) OUTPUT(*LIST)
  171. /* 2 */   MONMSG      MSGID( CPF3309 CPF3342 CPF3344 ) EXEC(DO)
  172.           GOTO        CPF3300
  173. /* 2 */   ENDDO
  174. /* 1 */   ENDDO
  175.  
  176.           IF  (&L_PRT *AND (*NOT &L_ALL))  CHGVAR &L_PRT  &FALSE
  177.  
  178. /* 1 */   IF          ((&X = &COUNT) *AND (&PRTATR = *LAST))  DO
  179.           DSPSPLFA    FILE(&SPLFILE) +
  180.                       JOB(&SPLJOB.&SPLUSR.&SPLJBN) +
  181.                       SPLNBR(&SPLNBR) OUTPUT(*LIST)
  182. /* 2 */   MONMSG      MSGID( CPF3309 CPF3342 CPF3344 ) EXEC(DO)
  183.           GOTO        CPF3300
  184. /* 2 */   ENDDO
  185. /* 1 */   ENDDO
  186.  
  187. /* 1 */   IF          (&CNLSPLF = *YES)  DO
  188.           CNLSPLF     FILE(&SPLFILE) JOB(&SPLJOB.&SPLUSR.&SPLJBN) +
  189.                       SPLNBR(&SPLNBR)
  190. /* 2 */   MONMSG      MSGID( CPF3309 CPF3342 CPF3344 ) EXEC(DO)
  191.           GOTO        CPF3300
  192. /* 2 */   ENDDO
  193. /* 1 */   ENDDO
  194.  
  195.           CHGVAR      &MBROPT   *ADD
  196.           GOTO        LOOP
  197. EXIT_LOOP:
  198.  
  199.           CHGVAR      &COUNT50    &COUNT
  200.           CHGVAR      &COUNT$     &COUNT50
  201.           CHGVAR      &Y          1
  202. ZSUP2:
  203.           IF          ((&Y > 4) *OR (%SST(&COUNT$ &Y 1) *NE '0')) +
  204.             GOTO SEND_MSG
  205.           CHGVAR      &Y            (&Y+1)
  206.           GOTO        ZSUP2
  207. SEND_MSG:
  208.           SNDPGMMSG   MSGID(CPI9801) MSGF(QCPFMSG.QSYS) +
  209.                       TOPGMQ(*EXT) MSGTYPE(*STATUS)
  210.           CHGVAR      &Z            (6-&Y)
  211.           SNDPGMMSG   MSG( +
  212.                       %SST(&COUNT$ &Y &Z) +
  213.                       *BCAT 'SPLFs copied to ' *CAT +
  214.                       &FILE *TCAT '.' *CAT &LIBR *TCAT ', Mbr=' *CAT +
  215.                       &MBR *TCAT ', Cancel=' *CAT +
  216.                       &CNLSPLF *TCAT '.')
  217.           RETURN
  218.  
  219. CPF3300:
  220.           RCVMSG      MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&ERRMSGID)
  221.           SNDPGMMSG   MSGID(&ERRMSGID) MSGF(QCPFMSG) +
  222.                       MSGDTA(&MSGDTA) TOPGMQ(*PRV) MSGTYPE(*INFO)
  223.           GOTO LOOP
  224.  
  225. ERROR:    RCVMSG      MSGTYPE(*DIAG) MSGDTA(&MSGDTA) MSGID(&ERRMSGID)
  226.           IF          (&ERRMSGID *EQ '       ') GOTO ESCAPE
  227.           SNDPGMMSG   MSGID(&ERRMSGID) MSGF(QCPFMSG) +
  228.                       MSGDTA(&MSGDTA) MSGTYPE(*DIAG)
  229.           GOTO        ERROR
  230.        /* Loop back for additional diagnostics  */
  231. ESCAPE:   RCVMSG      MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&ERRMSGID)
  232.           SNDPGMMSG   MSGID(&ERRMSGID) MSGF(QCPFMSG) +
  233.                       MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE)
  234.           ENDPGM
  235.