midrange.com code scratchpad
Name:
Command MOVOUTQ with List Spooled Files (QUSLSPL) API
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
07/03/2013 03:03:29 am
IP:
Logged
Description:
Command MOVOUTQ with List Spooled Files (QUSLSPL) API
Only spooled file status RDY, SAV, HLD selected to move
Code:
  1. /*  ===============================================================  */
  2. /*  = Command MovOutQ    CPP                                      =  */
  3. /*  =   MovOutQ    CLP                                            =  */
  4. /*  =   Paramater notes:                                          =  */
  5. /*  =     FromOutq: from outq                                     =  */
  6. /*  =     ToOutq  : to outq                                       =  */
  7. /*  =                                                             =  */
  8. /*  =   Only spooled file status RDY, SAV, HLD selected to move   =  */
  9. /*  ===============================================================  */
  10. /*  = Date  : 2013/07/02                                          =  */
  11. /*  = Author: Vengoal Chang                                       =  */
  12. /*  ===============================================================  */
  13.  
  14. Pgm          (&qfromoutq &qtooutq)
  15.  
  16.      Dcl        &qfromoutq   *CHAR  20
  17.      Dcl        &qtooutq     *CHAR  20
  18.  
  19.      Dcl        &FROMLIB     *CHAR  10
  20.      Dcl        &FROMOUTQ    *CHAR  10
  21.      Dcl        &FROMQUAL    *CHAR  20
  22.      Dcl        &TOLIB       *CHAR  10
  23.      Dcl        &TOOUTQ      *CHAR  10
  24.  
  25.      Dcl        &PDATA       *PTR
  26.      Dcl        &PGENERIC    *PTR
  27.      Dcl        &PUSRSPC     *PTR
  28.  
  29.      Dcl        &SFJNAME     *CHAR  10
  30.      Dcl        &SFJUSER     *CHAR  10
  31.      Dcl        &SFJNBR      *CHAR   6
  32.      Dcl        &SFNAME      *CHAR  10
  33.      Dcl        &SFNBR       *CHAR   4
  34.      Dcl        &SFSTS       *UINT   4
  35.  
  36.      Dcl        &USGENERIC   *CHAR  STG(*BASED) +
  37.                   LEN(256) BASPTR(&PGENERIC)
  38.      Dcl        &USDTAOFF    *UINT   4
  39.      Dcl        &USDTACNT    *UINT   4
  40.      Dcl        &USDTASIZ    *UINT   4
  41.      Dcl        &USDTAENT    *CHAR  STG(*BASED) +
  42.                   LEN(256) BASPTR(&PDATA)
  43.  
  44.      Dcl        &CH4         *CHAR   4
  45.      Dcl        &CH4A        *CHAR   4
  46.      Dcl        &CH4B        *CHAR   4
  47.      Dcl        &OFFSET      *UINT   4
  48.      Dcl        &OFFSET2     *UINT   4
  49.      Dcl        &USRSPC      *CHAR  20
  50.      Dcl        &USRSPCL     *CHAR  10  'QTEMP     '
  51.      Dcl        &USRSPCS     *CHAR  10
  52.      Dcl        &X           *UINT   4  0
  53.  
  54.      MonMsg     CPF0000      *N        GoTo Error
  55.  
  56. /* First ensure that variables are extracted correctly */
  57.  
  58.      ChgVar     &FromOutQ  %SST(&qfromoutq 1 10)
  59.      ChgVar     &FromLib   %SST(&qfromoutq 11 10)
  60.  
  61.      ChgVar     &ToOutQ    %SST(&qtooutq 1 10)
  62.      ChgVar     &ToLib     %SST(&qtooutq 11 10)
  63.  
  64. /* Resolve special values */
  65.  
  66.      If         (&ToOutQ *EQ '*FROMOUTQ')  +
  67.                   ChgVar   &ToOutQ &FromOutQ
  68.  
  69.      RtvObjD    Obj(&FromLib/&FromOutQ) ObjType(*OUTQ) +
  70.                   RtnLib(&FromLib)
  71.  
  72.      RtvObjD    Obj(&ToLib/&ToOutQ) ObjType(*OUTQ) +
  73.                   RtnLib(&ToLib)
  74.  
  75. /*  If both from and to are the same then issue an error */
  76.  
  77.      If         ((&FromLib *EQ &ToLib)    *AND  +
  78.                  (&FRomOutQ *EQ &ToOutQ))     DO
  79.                 SndPgmMsg  MsgID(CPF9898) MsgF(QCPFMSG) +
  80.                            MsgDta('FromOutQ could not same as +
  81.                            ToOutQ') MsgType(*ESCAPE)
  82.                 Return
  83.      EndDO
  84.  
  85.      SndPgmMsg  MsgID(CPF9898) MsgF(QCPFMSG) +
  86.                   MsgDta('Retrieving output queue entries') +
  87.                   ToPgmQ(*EXT) MsgType(*STATUS)
  88.  
  89.      ChgVar     &USRSPCS   'MOVOUTQSPC'
  90.      ChgVar     &USRSPC    (&USRSPCS *CAT &USRSPCL)
  91.  
  92.      ChgVar     &FROMQUAL  (&FROMOUTQ *CAT &FROMLIB)
  93.  
  94.      DltUsrSpc  UsrSpc(&USRSPCL/&USRSPCS)
  95.      MonMsg     CPF0000
  96.  
  97.      Call       QUSCRTUS  (&USRSPC 'MOVOUTQ   ' +
  98.                            X'00000100' x'00' '*ALL      ' 'User space +
  99.                            for MOVOUTQ                            ')
  100.  
  101.      Call       QUSLSPL   (&USRSPC 'SPLF0300' +
  102.                            '*ALL      ' &FROMQUAL '*ALL      ' +
  103.                            '*ALL      ')
  104.  
  105. /* Get header information pointer */
  106.  
  107.      Call       QUSPTRUS  (&USRSPC &PUSRSPC)
  108.  
  109. /* Generic Header is at offset x'6C'-decimal 108 */
  110.  
  111.      ChgVar     &PGENERIC  &PUSRSPC
  112.      ChgVar     &OFFSET    %OFFSET(&PGENERIC)
  113.      ChgVar     &OFFSET2   (&OFFSET + 108)
  114.      ChgVar     %OFFSET(&PGENERIC)  &OFFSET2
  115.  
  116. /* Get user data offset */
  117.      ChgVar     &CH4       %SST(&USGENERIC 17 4)
  118.      ChgVar     &USDTAOFF  %BIN(&CH4)
  119.  
  120. /* Get user data size */
  121.      ChgVar     &CH4       %SST(&USGENERIC 29 4)
  122.      ChgVar     &USDTASIZ  %BIN(&CH4)
  123.  
  124. /* Get number of entries for status message */
  125.      ChgVar     &CH4       %SST(&USGENERIC 25 4)
  126.      ChgVar     &USDTACNT  %BIN(&CH4)
  127.  
  128. /* If no entries, then bypass processing */
  129.      If         (&USDTACNT *EQ 0) +
  130.                 Goto END
  131. /* link to first data entry */
  132.  
  133.      ChgVar     &PDATA     &PUSRSPC
  134.      ChgVar     &OFFSET    %OFFSET(&PDATA)
  135.      ChgVar     &OFFSET2   (&OFFSET + &USDTAOFF)
  136.      ChgVar     %OFFSET(&PDATA)  &OFFSET2
  137.  
  138.      ChgVar     &X         1
  139.      ChgVar     %BIN(&CH4A)  &X
  140.      ChgVar     %BIN(&CH4B)  &USDTACNT
  141.  
  142. /* Process the list of entries on the usrspc */
  143.  
  144.  LOOP:
  145.  
  146.      ChgVar     &SFJNAME     %SST(&USDTAENT 1 10)
  147.      ChgVar     &SFJUSER     %SST(&USDTAENT 11 10)
  148.      ChgVar     &SFJNBR      %SST(&USDTAENT 21 6)
  149.      ChgVar     &SFNAME      %SST(&USDTAENT 27 10)
  150.      ChgVar     &CH4         %SST(&USDTAENT 37 4)
  151.      ChgVar     &SFNBR       %BIN(&CH4)
  152.      ChgVar     &CH4         %SST(&USDTAENT 41 4)
  153.      ChgVar     &SFSTS       %BIN(&CH4)
  154.  
  155.      If         (&SFSTS *EQ 1  *OR +
  156.                  &SFSTS *EQ 4  *OR +
  157.                  &SFSTS *EQ 6 ) Do
  158.        ChgSplFa   File(&SFNAME)                          +
  159.                     Job(&SFJNBR/&SFJUSER/&SFJNAME)       +
  160.                     SplNbr(&SFNBR) OutQ(&TOLIB/&TOOUTQ)
  161.      EndDo
  162.      Else Do
  163.        SndPgmMsg  MsgID(CPF9898) MsgF(QCPFMSG) +
  164.                     MsgDta('Spooled file' *BCAT      +
  165.                            &SFNAME  *Bcat 'in job' *BCAT +
  166.                            &SFJNBR  *CAT  '/' *CAT   +
  167.                            &SFJUSER *TCAT '/' *CAT   +
  168.                            &SFJNAME *BCAT 'in' *BCAT +
  169.                            &FROMLIB *TCAT '/' *CAT   +
  170.                            &FROMOUTQ *BCAT           +
  171.                           'is not moved.') +
  172.                           ToPgmQ(*EXT) MsgType(*STATUS)
  173.      EndDo
  174.  
  175.      IF         (&X *LT &USDTACNT)  DO
  176.        ChgVar     &OFFSET      %OFFSET(&PDATA)
  177.        ChgVar     &OFFSET2     (&OFFSET + &USDTASIZ)
  178.        ChgVar     %OFFSET(&PDATA)    &OFFSET2
  179.        ChgVar     &X           (&X + 1)
  180.        ChgVar     %BIN(&CH4A)  &X
  181.        Goto       LOOP
  182.      EndDo
  183.  
  184.  END:
  185.      DltUsrSpc  UsrSpc(&USRSPCL/&USRSPCS)
  186.  
  187.  Return:
  188.      Return
  189.  
  190. /*-- Error handling:  -----------------------------------------------*/
  191.  Error:
  192.      Call      QMHMOVPM    ( '    '                                  +
  193.                              '*DIAG'                                 +
  194.                              x'00000001'                             +
  195.                              '*PGMBDY'                               +
  196.                              x'00000001'                             +
  197.                              x'0000000800000000'                     +
  198.                            )
  199.  
  200.      Call      QMHRSNEM    ( '    '                                  +
  201.                              x'0000000800000000'                     +
  202.                            )
  203.  
  204.  EndPgm:
  205.      EndPgm
  206.  
  207.  
  208. /*  ===============================================================  */
  209. /*  = Command....... MovOutQ                                      =  */
  210. /*  = CPP........... MovOutQ  CLP                                 =  */
  211. /*  = Description... Move output queue spooled files to another   =  */
  212. /*  =                output queue                                 =  */
  213. /*  =                                                             =  */
  214. /*  = CrtCmd      Cmd( MovOutQ   )                                =  */
  215. /*  =             Pgm( MovOutQ    )                               =  */
  216. /*  =             SrcFile( YourSourceFile )                       =  */
  217. /*  ===============================================================  */
  218. /*  = Date  : 2013/07/02                                          =  */
  219. /*  = Author: Vengoal Chang                                       =  */
  220. /*  ===============================================================  */
  221.              CMD        PROMPT('Move Output Queue')
  222.  
  223.  
  224.              PARM       KWD(FROMOUTQ) TYPE(FROM) PROMPT('From output +
  225.                           queue')
  226.  
  227.              PARM       KWD(TOOUTQ) TYPE(TO) PROMPT('To output queue')
  228.  
  229.  
  230.  FROM:       QUAL       TYPE(*NAME) LEN(10) MIN(1)
  231.              QUAL       TYPE(*NAME) LEN(10) DFT(*LIBL) +
  232.                           SPCVAL((*LIBL)) PROMPT('Library')
  233.  
  234.  TO:         QUAL       TYPE(*NAME) LEN(10) DFT(*FROMOUTQ) +
  235.                           SPCVAL((*FROMOUTQ))
  236.              QUAL       TYPE(*NAME) LEN(10) DFT(*LIBL) +
  237.                           SPCVAL((*LIBL)) PROMPT('Library')
  238.  
© 2004-2019 by midrange.com generated in 0.007s valid xhtml & css