如何將 outq 中所有報表搬移至另一個 outq ？(Command MOVOUTQ with List Spooled Files (QUSLSPL) API)
File : QCLSRC
Member: MOVOUTQ
Type : CLP
Usage : CRTCLPGM MOVOUTQ TGTRLS(V5R4M0)
OS : V5R4 later
/* =============================================================== */
/* = Command MovOutQ CPP = */
/* = MovOutQ CLP = */
/* = Paramater notes: = */
/* = FromOutq: from outq = */
/* = ToOutq : to outq = */
/* = = */
/* = Only spooled file status RDY, SAV, HLD selected to move = */
/* =============================================================== */
/* = Date : 2013/07/02 = */
/* = Author: Vengoal Chang = */
/* =============================================================== */
Pgm (&qfromoutq &qtooutq)
Dcl &qfromoutq *CHAR 20
Dcl &qtooutq *CHAR 20
Dcl &FROMLIB *CHAR 10
Dcl &FROMOUTQ *CHAR 10
Dcl &FROMQUAL *CHAR 20
Dcl &TOLIB *CHAR 10
Dcl &TOOUTQ *CHAR 10
Dcl &PDATA *PTR
Dcl &PGENERIC *PTR
Dcl &PUSRSPC *PTR
Dcl &SFJNAME *CHAR 10
Dcl &SFJUSER *CHAR 10
Dcl &SFJNBR *CHAR 6
Dcl &SFNAME *CHAR 10
Dcl &SFNBR *CHAR 4
Dcl &SFSTS *UINT 4
Dcl &USGENERIC *CHAR STG(*BASED) +
LEN(256) BASPTR(&PGENERIC)
Dcl &USDTAOFF *UINT 4
Dcl &USDTACNT *UINT 4
Dcl &USDTASIZ *UINT 4
Dcl &USDTAENT *CHAR STG(*BASED) +
LEN(256) BASPTR(&PDATA)
Dcl &CH4 *CHAR 4
Dcl &CH4A *CHAR 4
Dcl &CH4B *CHAR 4
Dcl &OFFSET *UINT 4
Dcl &OFFSET2 *UINT 4
Dcl &USRSPC *CHAR 20
Dcl &USRSPCL *CHAR 10 'QTEMP '
Dcl &USRSPCS *CHAR 10
Dcl &X *UINT 4 0
MonMsg CPF0000 *N GoTo Error
/* First ensure that variables are extracted correctly */
ChgVar &FromOutQ %SST(&qfromoutq 1 10)
ChgVar &FromLib %SST(&qfromoutq 11 10)
ChgVar &ToOutQ %SST(&qtooutq 1 10)
ChgVar &ToLib %SST(&qtooutq 11 10)
/* Resolve special values */
If (&ToOutQ *EQ '*FROMOUTQ') +
ChgVar &ToOutQ &FromOutQ
RtvObjD Obj(&FromLib/&FromOutQ) ObjType(*OUTQ) +
RtnLib(&FromLib)
RtvObjD Obj(&ToLib/&ToOutQ) ObjType(*OUTQ) +
RtnLib(&ToLib)
/* If both from and to are the same then issue an error */
If ((&FromLib *EQ &ToLib) *AND +
(&FRomOutQ *EQ &ToOutQ)) DO
SndPgmMsg MsgID(CPF9898) MsgF(QCPFMSG) +
MsgDta('FromOutQ could not same as +
ToOutQ') MsgType(*ESCAPE)
Return
EndDO
SndPgmMsg MsgID(CPF9898) MsgF(QCPFMSG) +
MsgDta('Retrieving output queue entries') +
ToPgmQ(*EXT) MsgType(*STATUS)
ChgVar &USRSPCS 'MOVOUTQSPC'
ChgVar &USRSPC (&USRSPCS *CAT &USRSPCL)
ChgVar &FROMQUAL (&FROMOUTQ *CAT &FROMLIB)
DltUsrSpc UsrSpc(&USRSPCL/&USRSPCS)
MonMsg CPF0000
Call QUSCRTUS (&USRSPC 'MOVOUTQ ' +
X'00000100' x'00' '*ALL ' 'User space +
for MOVOUTQ ')
Call QUSLSPL (&USRSPC 'SPLF0300' +
'*ALL ' &FROMQUAL '*ALL ' +
'*ALL ')
/* Get header information pointer */
Call QUSPTRUS (&USRSPC &PUSRSPC)
/* Generic Header is at offset x'6C'-decimal 108 */
ChgVar &PGENERIC &PUSRSPC
ChgVar &OFFSET %OFFSET(&PGENERIC)
ChgVar &OFFSET2 (&OFFSET + 108)
ChgVar %OFFSET(&PGENERIC) &OFFSET2
/* Get user data offset */
ChgVar &CH4 %SST(&USGENERIC 17 4)
ChgVar &USDTAOFF %BIN(&CH4)
/* Get user data size */
ChgVar &CH4 %SST(&USGENERIC 29 4)
ChgVar &USDTASIZ %BIN(&CH4)
/* Get number of entries for status message */
ChgVar &CH4 %SST(&USGENERIC 25 4)
ChgVar &USDTACNT %BIN(&CH4)
/* If no entries, then bypass processing */
If (&USDTACNT *EQ 0) +
Goto END
/* link to first data entry */
ChgVar &PDATA &PUSRSPC
ChgVar &OFFSET %OFFSET(&PDATA)
ChgVar &OFFSET2 (&OFFSET + &USDTAOFF)
ChgVar %OFFSET(&PDATA) &OFFSET2
ChgVar &X 1
ChgVar %BIN(&CH4A) &X
ChgVar %BIN(&CH4B) &USDTACNT
/* Process the list of entries on the usrspc */
LOOP:
ChgVar &SFJNAME %SST(&USDTAENT 1 10)
ChgVar &SFJUSER %SST(&USDTAENT 11 10)
ChgVar &SFJNBR %SST(&USDTAENT 21 6)
ChgVar &SFNAME %SST(&USDTAENT 27 10)
ChgVar &CH4 %SST(&USDTAENT 37 4)
ChgVar &SFNBR %BIN(&CH4)
ChgVar &CH4 %SST(&USDTAENT 41 4)
ChgVar &SFSTS %BIN(&CH4)
If (&SFSTS *EQ 1 *OR +
&SFSTS *EQ 4 *OR +
&SFSTS *EQ 6 ) Do
ChgSplFa File(&SFNAME) +
Job(&SFJNBR/&SFJUSER/&SFJNAME) +
SplNbr(&SFNBR) OutQ(&TOLIB/&TOOUTQ)
EndDo
Else Do
SndPgmMsg MsgID(CPF9898) MsgF(QCPFMSG) +
MsgDta('Spooled file' *BCAT +
&SFNAME *Bcat 'in job' *BCAT +
&SFJNBR *CAT '/' *CAT +
&SFJUSER *TCAT '/' *CAT +
&SFJNAME *BCAT 'in' *BCAT +
&FROMLIB *TCAT '/' *CAT +
&FROMOUTQ *BCAT +
'is not moved.') +
ToPgmQ(*EXT) MsgType(*STATUS)
EndDo
IF (&X *LT &USDTACNT) DO
ChgVar &OFFSET %OFFSET(&PDATA)
ChgVar &OFFSET2 (&OFFSET + &USDTASIZ)
ChgVar %OFFSET(&PDATA) &OFFSET2
ChgVar &X (&X + 1)
ChgVar %BIN(&CH4A) &X
Goto LOOP
EndDo
END:
DltUsrSpc UsrSpc(&USRSPCL/&USRSPCS)
Return:
Return
/*-- Error handling: -----------------------------------------------*/
Error:
Call QMHMOVPM ( ' ' +
'*DIAG' +
x'00000001' +
'*PGMBDY' +
x'00000001' +
x'0000000800000000' +
)
Call QMHRSNEM ( ' ' +
x'0000000800000000' +
)
EndPgm:
EndPgm
File : QCMDSRC
Member: MOVOUTQ
Type : CMD
Usage : CRTCMD CMD(MOVOUTQ) PGM(MOVOUTQ)
/* =============================================================== */
/* = Command....... MovOutQ = */
/* = CPP........... MovOutQ CLP = */
/* = Description... Move output queue spooled files to another = */
/* = output queue = */
/* = = */
/* = CrtCmd Cmd( MovOutQ ) = */
/* = Pgm( MovOutQ ) = */
/* = SrcFile( YourSourceFile ) = */
/* =============================================================== */
/* = Date : 2013/07/02 = */
/* = Author: Vengoal Chang = */
/* =============================================================== */
CMD PROMPT('Move Output Queue')
PARM KWD(FROMOUTQ) TYPE(FROM) PROMPT('From output +
queue')
PARM KWD(TOOUTQ) TYPE(TO) PROMPT('To output queue')
FROM: QUAL TYPE(*NAME) LEN(10) MIN(1)
QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) +
SPCVAL((*LIBL)) PROMPT('Library')
TO: QUAL TYPE(*NAME) LEN(10) DFT(*FROMOUTQ) +
SPCVAL((*FROMOUTQ))
QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) +
SPCVAL((*LIBL)) PROMPT('Library')
參考資訊:
List Spooled Files (QUSLSPL) API
星期四, 11月 09, 2023
2013-07-03 如何將 outq 中所有報表搬移至另一個 outq ？(Command MOVOUTQ with List Spooled Files (QUSLSPL) API)
星期三, 11月 08, 2023
2011-01-04 如何將 WRKOUTQ 輸出至 data base file 中(CVTOUTQ)
如何將 WRKOUTQ 輸出至 data base file 中(CVTOUTQ)
File : QDDSSRC
Member: CVTOUTQP
Type : PF
Usage : CRTPF CVTOUTQP
A* Out file used by CVTOUTQ command - OUTQP file
A R SPLREC
A SPOUTQ 10 COLHDG('Output' 'queue' +
A 'name')
A SPOQLB 10 COLHDG('Output' 'queue' +
A 'library')
A SPCVTD 6 COLHDG('WRKOUTQ' +
A 'convert' 'date')
A SPCVTT 6 COLHDG('WRKOUTQ' +
A 'convert' 'time')
A SPFILE 10 COLHDG('Spool' 'file' +
A 'name')
A SPUSER 10 COLHDG('User name')
A SPUDTA 10 COLHDG('User data')
A SPSTS 3 COLHDG('Spool' 'file' +
A 'status')
A SPNREC 6 0 COLHDG('Nbr of' +
A 'diskette' 'records')
A SPNPAG 9 0 COLHDG('Nbr of' 'pages')
A SPWRTP 9 0 COLHDG('Page' 'being' +
A 'written')
A SPSTRP 9 0 COLHDG('Start' 'page')
A SPENDP 9 0 COLHDG('End' 'page')
A SPLSTP 9 0 COLHDG('Last' 'page')
A SPRESP 9 0 COLHDG('Restart' 'page')
A SPCPY 9 0 COLHDG('Nbr' 'of' 'copies')
A SPCPYL 9 0 COLHDG('Copies' 'left to' +
A 'print')
A SPFTYP 10 COLHDG('Form type')
A SPPTY 1 COLHDG('Spool' 'file' +
A 'pty')
A SPFNBR 6 COLHDG('Spool' 'file' +
A 'number')
A SPJNAM 10 COLHDG('Job name')
A SPJNBR 6 COLHDG('Job' 'number')
A SPCEN 1 COLHDG('Spool' 'file' +
A 'century')
A TEXT('Spool file open +
A century')
A SPDAT 6 COLHDG('Spool' 'file' +
A 'date')
A TEXT('Spool file open +
A date YYMMDD')
A SPTIM 6 COLHDG('Spool' 'file' +
A 'time')
A TEXT('Spool file open +
A time')
A SPSCHD 10 COLHDG('Schedule')
A SPHOLD 10 COLHDG('Hold')
A SPSAVF 10 COLHDG('Save' 'file')
A SPLPI 9 1 COLHDG('LPI')
A SPCPI 9 1 COLHDG('CPI')
A SPACGC 15 COLHDG('Accounting' +
A 'code')
A SPDEV 10 COLHDG('Device' 'file' +
A 'name')
A SPDEVL 10 COLHDG('Device' 'file' +
A 'library')
A SPPGM 10 COLHDG('Program' 'that' +
A 'opened')
A SPPGML 10 COLHDG('Pgm lib' 'that' +
A 'opened')
A SPPRTX 30 COLHDG('Print' 'text')
A SPPAGL 9 0 COLHDG('Page' 'length')
A SPPAGW 9 0 COLHDG('Page' 'width')
A SPNSEP 9 0 COLHDG('Nbr or' +
A 'separators')
A SPOFLN 9 0 COLHDG('Overflow' 'line')
A SPFONT 10 COLHDG('Font')
A SPPGRT 9 0 COLHDG('Page' 'rotation')
A SPJUST 9 0 COLHDG('Page' +
A 'justification')
A SPBOTH 10 COLHDG('Print' 'on both' +
A 'sides')
A SPFOLD 10 COLHDG('Fold')
A SPALGN 10 COLHDG('Alignment')
A SPPQTY 10 COLHDG('Print' 'quality')
A SPPFID 10 COLHDG('Print' 'fidelity')
A SPRLEN 9 0 COLHDG('Record' +
A 'length')
A SPMAXR 9 0 COLHDG('Maximum' +
A 'record')
A SPSRCD 9 0 COLHDG('Source' 'drawer')
A SPDEVT 10 COLHDG('Device' 'type')
A SPPRTT 10 COLHDG('Printer' 'type')
A SPDOC 12 COLHDG('Document' 'name')
A SPFLDR 64 COLHDG('Folder' 'name')
A SPCDEP 10 COLHDG('Code' 'page')
A SPGRST 10 COLHDG('Graphic' 'set')
A SPDUPX 10 COLHDG('Duplex')
A SPCTLC 10 COLHDG('Control' 'char')
A K SPFILE
File : QRPGLESRC
Member: CVTOUTQR
Type : RPGLE
Usage : CRTBNDRPG PGM(CVTOUTQR) TGTRLS(V5R1M0)
Target release must be V5R1 later for free format.
H**************************************************************
H*
H* FUNTION: THIS APPLICATION WILL DELETE OLD SPOOLED FILES
H* FROM THE SYSTEM, BASED ON THE INPUT PARAMETERS.
H*
H* API USED: QUSCRTUS CREATE USER SPACE
H* QUSLSPL GENERATE SPOOLED FILE LIST
H* QUSRTVUS RETRIEVE USER SPACE INFORMATION
H* QUSRSPLA RETRIEVE SPOOLED FILE ATR INFORMATION
H*
H DEBUG OPTION(*SRCSTMT:*NODEBUGIO)
FCVTOUTQP UF A E K Disk
D CvtOutqR PR ExtPgm('CVTOUTQR')
D sOutq 20A CONST
D CvtOutqR PI
D sOutq 20A CONST
D RunCLCmd PR EXTPGM('QCMDEXC')
D CmdStr 512 CONST OPTIONS(*VARSIZE)
D CmdLen 15 5 CONST
D SndPgmMsg PR ExtPgm( 'QMHSNDPM' )
D MsgID 7
D QualMsgF 20
D MsgDta 256
D MsgDtaLen 10I 0
D EscMsgType 10
D CallStkEnt 10
D CallStkCnt 10I 0
D MsgKey 4
D Error 8
D RcvPgmMsg PR ExtPgm( 'QMHRCVPM' )
D MsgDta 256
D MsgDtaLen 10I 0
D MsgFormat 8
D CallStkEnt 10
D CallStkCnt 10I 0
D MsgType 10
D MsgKey 4
D MsgWait 10I 0
D MsgAction 10
D Error 8
* SndMsg Parameter declare
D QualMsgF DS
D MsgFName 10 Inz( 'QCPFMSG' )
D MsgFLib 10 Inz( 'QSYS' )
D MsgID s 7 inz('CPF9898')
D MsgDta S 256
D MsgType S 10 Inz( '*COMP')
D MsgDtaLen S 10I 0 Inz(512)
D CallStkEnt S 10 Inz( '*' )
D CallStkCnt S 10I 0 Inz( 2 )
D MsgKey S 4 Inz(*blanks)
D MsgError S 8 Inz( *AllX'00' )
* MSGTYPE ENT CallStkcnt Joblog End(line 24) X:message N: No Message
* INFO * 2 XX X
* COMP * 2 XX X
* INFO * 1 X N
* COMP * 1 X N
* INFO * 0 X N
* COMP * 0 X N
* STATUS * 2 Error Error
* STATUS * 1 N N
* STATUS * 0 N N
* RcvMsg Parameter declare
D MsgFormat s 8 inz('RCVM0100')
D RMsgType S 10 Inz( '*LAST')
D MsgWait s 10I 0 inz( 0 )
D MsgAction s 10 inz('*OLD')
D CurrMsgStk S 10I 0 inz( 0 )
* API Error data structure
DQUSEC DS
D QUSBPRV 10I 0 Inz(%size(QUSEC))
D QUSBAVL 10I 0
D QUSEI 7
D QUSERVED 1
D*MSGDTA 256
D*
*
* Parameter for Create User Space Begin
D USRSPC DS
D USNAME 1 10 INZ('USRSPC ')
D USLIB 11 20 INZ('QTEMP ')
*
D DS
D EXTATR 1 10 INZ('QUSLSPL ')
D USINIT 11 11 INZ(X'00')
D FMTNME 12 21 INZ('SPLF0100')
D FMTNM1 22 31 INZ('SPLA0100')
*
D DS
D USSIZE 10I 0 INZ(640000)
* Parameter for Create User Space End
* Retrive User Space Entry data
D RCVVAR DS
D OFFSET 1 4B 0
D NOENTR 9 12B 0
D LSTSIZ 13 16B 0
* Retrive User Space Spooled data
D RCVAR1 DS
D USRNM1 1 10
D OUTQNA 11 30
D OUTQ 11 20
D OUTQL 21 30
D USRDT1 31 40
D FRMTY1 41 50
D IJOBID 51 66
D ISPLID 67 82
* Spooled file Attributes parameter Begin
D RCVAR2 DS
D BYTRTN 1 4B 0
D BYTVAL 5 8B 0
D JOBID 9 24
D SPLFID 25 40
D JOBNAM 41 50
D USRNAM 51 60
D JOBNUM 61 66
D FILNAM 67 76
D FILNUM 77 80B 0
D FRMTYP 81 90
D USRDTA 91 100
D STATUS 101 110
D FILVAL 111 120
D HLDF 121 130
D SAVF 131 140
D TOTPAG 141 144B 0
D PAGWRT 145 148B 0
D STRPAG 149 152B 0
D ENDPAG 153 156B 0
D LASPAG 157 160B 0
D RESPRT 161 164B 0
D TOTCPY 165 168B 0
D CPYLFT 169 172B 0
D LPI 173 176B 0
D CPI 177 180B 0
D OUTPRI 181 182
D OUTQNM 183 192
D OUTQLB 193 202
D DATFOP 203 209
D DATCEN 203 203
D DATYR 204 205
D DATMTH 206 207
D DATDAY 208 209
D TIMFOP 210 215
D DEVFNA 216 225
D DEVFLB 226 235
D PGMOPF 236 245
D PGMOPL 246 255
D ACCCOD 256 270
D PRTTXT 271 300
D RCDLEN 301 304B 0
D MAXRCD 305 308B 0
D DEVCLS 309 318
D PRTTYP 319 328
D DOCNAM 329 340
D FLDNAM 341 404
D S36PRC 405 412
D PRTFID 413 422
D RPLUN 423 423
D RPLCHR 424 424
D PAGLEN 425 428B 0
D PAGWID 429 432B 0
D NUMSEP 433 436B 0
D OVRLIN 437 440B 0
D DBCSDA 441 450
D DBCSEC 451 460
D DBCSSO 461 470
D DBCSCR 471 480
D DBCSCI 481 484B 0
D GRAPHI 485 494
D CODPAG 495 504
D FORNAM 505 514
D FORLIB 515 524
D SRCDRW 525 528B 0
D PRTFON 529 538
D S36SPL 539 544
D PAGROT 545 548B 0
D JUSTIF 549 552B 0
D PRTBOT 553 562
D FLDRCD 563 572
D CTLCHR 573 582
D ALGFRM 583 592
D PRTQUA 593 602
D FRMFED 603 612
D VOLUME 613 683
D FLABID 684 700
D EXCTYP 701 710
D CHRCOD 711 720
D TOTRCD 721 724B 0
D PGPSID 725 728B 0
D FOVNAM 729 738
D FOVLIB 739 748
D FOVOFD 749 756P 5
D FOVOFA 757 764P 5
D BOVNAM 765 774
D BOVLIB 775 784
D BOVOFD 785 792P 5
D BOVOFA 793 800P 5
D UOM 801 810
D PAGNAM 811 820
D PAGLIB 821 830
D LINSPC 831 840
D PNTSIZ 841 848P 5
* Spooled file Attributes parameter End
* Retrive User Space Parameter Begin
D DS
D LENDTA 1 4B 0
D STRPOS 5 8B 0
D SPLF# 9 12B 0
D RCVLE1 13 16B 0
D FIL# 17 22
D RCVLE2 23 26B 0
* Retrive User Space Parameter End
* Work area variable
D WRKSTR S 100
D RcvMsgId S 7
*
*
C*********************************************************
C*
C* OPERABLE CODE STARTS HERE
C*
C*********************************************************
C*
C Eval *InLR = *On
C*
C* CREATE USER SPACE USING TE PARAMETERS FROM THE CL COMMAND
C*
C Z-ADD 16 QUSBPRV
*
C CALL 'QUSCRTUS'
C PARM USRSPC
C PARM EXTATR
C PARM USSIZE
C PARM USINIT
C PARM '*ALL' USAUTH 10 AUTHORITY
C PARM *BLANKS USTEXT 50
C PARM '*YES' USRPLC 10 REPLACE
C PARM QUSEC
*
C*
C* FILL THE USER SPACE JUST CREATED WITH SPOOLED FILES AS
C* DEFINED IN THE CL COMMAND
C*
C CALL 'QUSLSPL'
C PARM USRSPC
C PARM FMTNME
C PARM '*ALL' USRNME 10
C PARM sOUTQ FULLOUTQ 20
C PARM '*ALL' FRMTYP 10
C PARM '*ALL' USRDTA 10
C******************************************************
C*
C* BEGINNING OF LOOP
C*
C******************************************************
C*
C* YOU CAN USE QUSRTVUS API RETRIEVE USER SPACE ENTRY DATA
C*
C*****************************************************
C*
C Z-ADD 16 LENDTA
C Z-ADD 125 STRPOS
C*
C CALL 'QUSRTVUS'
C PARM USRSPC
C PARM STRPOS
C PARM LENDTA
C PARM RCVVAR
C*
C* CHECK RCVVAR DATA STRUCTURE FOR NUMBER OF LIST ENTRIES,OFFSET
C* TO LIST ENTRIES, AND SIZE OF EAC LIST ENTRY.
C* INFORMATION NEEDED FOR TE QUSLSPL API IS CONTAINED WITHIN
C* THE 164 BYTES OF FORMAT SPLF0100 LIST DATA SECTION
C*
C Z-ADD OFFSET STRPOS
C ADD 1 STRPOS
C Z-ADD LSTSIZ LENDTA
C Z-ADD 164 RCVLE1
C* Z-ADD 209 RCVLE2
C Z-ADD 750 RCVLE2
C Z-ADD 1 COUNT 15 0
C eval MsgDta = 'Total processing spooled files:' +
C %char(NOENTR)
C eval MsgType = '*INFO'
C ExSr SndMsg
C COUNT DOWLE NOENTR
C*
C* RETRIEVE THE INFORMATION FROM THE USER SPACE ABOUT THE SPOOLED
C* FILE.
C*
C CALL 'QUSRTVUS'
C PARM USRSPC
C PARM STRPOS
C PARM LENDTA
C PARM RCVAR1
C TIME FULTIM 12 0
C MOVEL FULTIM SPCVTT
C MOVE FULTIM SPCVTD
C MOVE OUTQ SPOUTQ
C MOVE OUTQL SPOQLB
C*
C* NOW RETRIVE SPOOLED ATR USING THE INFORMATION IN THE
C* USER SPACE , WHICH WAS RETRIVED BEFORE THIS COMMENT.
C*
C MOVE IJOBID JOBID
C MOVE ISPLID SPLFID
C MOVE *BLANKS JOBINF
C MOVEL '*INT' SPLFNM 10
C MOVE *BLANKS SPLF#
C MOVEL '*INT' JOBINF 26
C*
C Reset QUSEC
C CALL 'QUSRSPLA'
C PARM RCVAR2
C PARM RCVLE2
C PARM FMTNM1
C PARM JOBINF
C PARM JOBID
C PARM SPLFID
C PARM SPLFNM
C PARM SPLF#
C PARM QUSEC
* Call API No Error
C If QUSBAVL = 0
C* CHECK RCVAR1 DATA STRUCTURE FOR DATA FILE OPENED.
C*
C *CYMD0 TEST(DE) DATFOP
C If NOT %ERROR
C MOVE JOBNAM SPJNAM
C MOVE USRNAM SPUSER
C MOVE JOBNUM SPJNBR
C MOVE USRDTA SPUDTA
C MOVE FRMTYP SPFTYP
C MOVE FILNAM SPFILE
C Z-ADD FILNUM DEC6 6 0
C MOVE DEC6 SPFNBR
C Z-ADD TOTCPY SPCPY
C MOVE CPYLFT SPCPYL
C MOVE OUTPRI SPPTY
C MOVEL FILVAL SPSCHD
C MOVEL HLDF SPHOLD
C MOVEL FLDRCD SPFOLD
C MOVE DATFOP SPDAT
C MOVEL DATFOP SPCEN
C MOVE TIMFOP SPTIM
C MOVE ACCCOD SPACGC
C MOVE PRTTXT SPPRTX
C MOVE DEVFNA SPDEV
C MOVE DEVFLB SPDEVL
C MOVE PGMOPF SPPGM
C MOVE PGMOPL SPPGML
C Z-ADD PAGLEN SPPAGL
C Z-ADD PAGWID SPPAGW
C Z-ADD TOTPAG SPNPAG
C Z-ADD PAGWRT SPWRTP
C Z-ADD STRPAG SPSTRP
C Z-ADD ENDPAG SPENDP
C Z-ADD LASPAG SPLSTP
C Z-ADD RESPRT SPRESP
C Z-ADD LPI DEC9 9 0
C MOVE DEC9 SPLPI
C Z-ADD CPI DEC9
C MOVE DEC9 SPCPI
C Z-ADD NUMSEP SPNSEP
C Z-ADD OVRLIN SPOFLN
C MOVE PRTFON SPFONT
C Z-ADD PAGROT SPPGRT
C MOVE PRTBOT SPBOTH
C Z-ADD JUSTIF SPJUST
C MOVE ALGFRM SPALGN
C MOVE PRTQUA SPPQTY
C MOVE PRTFID SPPFID
C Z-ADD TOTRCD SPNREC
C Z-ADD RCDLEN SPRLEN
C Z-ADD MAXRCD SPMAXR
C Z-ADD SRCDRW SPSRCD
C MOVE DEVCLS SPDEVT
C MOVE PRTTYP SPPRTT
C MOVE DOCNAM SPDOC
C MOVE FLDNAM SPFLDR
C MOVE CODPAG SPCDEP
C MOVE GRAPHI SPGRST
C MOVE CTLCHR SPCTLC
C MOVE FLDRCD SPDUPX
C* Special handling cases
C* Status in DS contains values like *READY. Change to 3 char
C Select
C when STATUS = '*READY '
C move 'RDY' SPSTS
C when STATUS = '*OPEN '
C MOVE 'OPN' SPSTS
C when STATUS = '*CLOSED '
C MOVE 'CLO' SPSTS
C when STATUS = '*HELD '
C MOVE 'HLD' SPSTS
C when STATUS = '*SAVED '
C MOVE 'SAV' SPSTS
C when STATUS = '*WRITING'
C MOVE 'WTR' SPSTS
C when STATUS = '*PENDING'
C MOVE 'PNS' SPSTS
C when STATUS = '*PRINTER'
C MOVE 'PRT' SPSTS
C EndSl
C Write SPLREC
C EndIf
C EndIf
C*
C* GO BACK AND PROCESS THE REST OF ENTRIES IN THE USER SPACE
C*
C ADD LSTSIZ STRPOS
C ADD 1 COUNT
C ENDDO
C******************************************
C* END LOOP
C******************************************
C*
C Eval MsgDta = %Char(NoEntr) +
C ' spooled files process ' +
C 'completely'
C eval MsgType = '*COMP'
C Exsr SndMsg
* -------------------------------------------------------------
* - Subroutine.... SndMsg -
* - Description... Send escape message when error is found -
* -------------------------------------------------------------
C SndMsg BegSr
C Eval MsgDtaLen = %Size( MsgDta )
C CallP SndPgmMsg( MsgID :
C QualMsgF :
C MsgDta :
C MsgDtaLen :
C MsgType :
C CallStkEnt :
C CallStkCnt :
C MsgKey :
C MsgError )
C EndSr
File : QCLSRC
Member: CVTOUTQC
Type : CLP
Usage : CRTCLPGM PGM(CVTOUTQC)
/* =============================================================== */
/* = Command CvtOutq CPP = */
/* = Description : Convert WRKOUTQ to a data base file = */
/* =============================================================== */
/* = Date : 2011/01/04 = */
/* = Author: Vengoal Chang = */
/* =============================================================== */
Pgm Parm(&FullOutQ &OutLib &OutMbr &Replace)
Dcl &FullOutq *Char 20
Dcl &OutLib *Char 10
Dcl &OutMbr *Char 10
Dcl &Replace *Char 4
Dcl &Outq *Char 10
Dcl &OutqLib *Char 10
Dcl &RtnObjLib *Char 10
MonMsg CPF0000 *N GoTo Error
ChkObj &OUTLIB/OUTQP OBJTYPE(*FILE)
MonMsg MsgId(CPF9801) exec(DO) /* No file */
IF (&OUTLIB *EQ '*LIBL') DO /* *LIBL was used */
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) +
MSGDTA('The OUTLIB cannot be *LIBL if no +
file exists') MSGTYPE(*ESCAPE)
ENDDO /* *LIBL was used */
RtvObjD OBJ(CVTOUTQ) OBJTYPE(*CMD) RTNLIB(&RtnObjLib)
Cpyf FromFile(&RtnObjLib/CVTOUTQP) +
ToFile(&OutLib/OUTQP) CrtFile(*YES)
RNMM File(&OutLib/OUTQP) Mbr(CVTOUTQP) +
NewMbr(OUTQP)
EndDo /* No file */
ChkObj &OutLib/OUTQP ObjType(*File) Mbr(&OutMbr)
MonMsg MsgId(CPF9815) EXEC(DO) /* No member */
AddPfm File(&OutLib/OUTQP) Mbr(&OutMbr)
ENDDO /* No member */
ChgVar &Outq %SST(&FullOutQ 1 10) /* Extract OUTQ */
ChgVar &OutQLib %SST(&FullOutQ 11 10) /* Extract */
ChkObj &OutQLib/&OutQ ObjType(*OUTQ)
IF (&OutQLib *EQ '*LIBL') DO /* *LIBL used */
RtvObjD Obj(&OutQLib/&OUTQ) ObjType(*OUTQ) +
RtnLib(&OutQLib)
ENDDO /* *LIBL used */
IF (&OutLib *EQ '*LIBL') DO /* *LIBL was used */
RtvObjD Obj(OUTQP) ObjType(*FILE) RtnLib(&OutLib)
ENDDO /* *LIBL was used */
IF (&Replace *EQ '*YES') DO /* Replace mbr */
ClrPfM File(&OutLib/OUTQP) MBR(&OutMbr)
ENDDO /* Replace mbr */
SndPgmMsg MsgId(CPF9898) Msgf(QCPFMSG) ToPgmQ(*EXT) +
MsgDta('Converting output queue ' *CAT +
&OutQ *TCAT ' in ' *CAT &OutQLib) +
MsgType(*STATUS)
OvrDbf CVTOUTQP ToFile(&OutLib/OUTQP) MBR(&OUTMBR)
Call CVTOUTQR (&FullOutQ)
DltOvr File(CVTOUTQP)
Return:
Return
/*-- Error handling: -----------------------------------------------*/
Error:
Call QMHMOVPM ( ' ' +
'*DIAG' +
x'00000001' +
'*PGMBDY' +
x'00000001' +
x'0000000800000000' +
)
Call QMHRSNEM ( ' ' +
x'0000000800000000' +
)
EndPgm:
EndPgm
File : QCMDSRC
Member: CVTOUTQ
Type : CMD
Usage : CRTCMD CMD( CVTOUTQ )
PGM( CVTOUTQC )
SRCMBR( CVTOUTQ )
/*****************************************************************/
/* */
/* COMMAND NAME: CVTOUTQ */
/* */
/* AUTHOR : Vengoal Chang */
/* */
/* DATE WRITTEN: 2011/01/04 */
/* */
/* DESCRIPTION : Convert WRKOUTQ to data base file */
/* */
/* CVTOUTQC *PGM CLP Command processing program */
/* CVTOUTQR *PGM RPGLE List spooled file entry to DB */
/* CVTOUTQP *FILE PF CVTOUTQ Outfile */
/* */
/* CRTCMD CMD( CVTOUTQ ) */
/* PGM( CVTOUTQC ) */
/* SRCMBR( CVTOUTQ ) */
/* */
/*****************************************************************/
CMD PROMPT('Convert Output Queue to DB')
PARM KWD(OUTQ) TYPE(QUAL1) SNGVAL((*NONE)) MIN(1) +
PROMPT('Output queue')
PARM KWD(OUTLIB) TYPE(*NAME) DFT(*LIBL) +
SPCVAL((*LIBL)) EXPR(*YES) +
PROMPT('Library for OUTQP file')
PARM KWD(OUTMBR) TYPE(*NAME) LEN(10) DFT(OUTQP) +
EXPR(*YES) PROMPT('Member to receive output')
PARM KWD(REPLACE) TYPE(*CHAR) LEN(4) RSTD(*YES) +
DFT(*YES) VALUES(*YES *NO) +
PROMPT('Replace data in member')
QUAL1: QUAL TYPE(*NAME) LEN(10) MIN(1) EXPR(*YES)
QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) +
SPCVAL((*LIBL)) EXPR(*YES) +
PROMPT('Library name')
2008-11-18 如何擷取 Outq 的屬性？(Command RTVOUTQA with API QSPROUTQ)
如何擷取 Outq 的屬性？(Command RTVOUTQA with API QSPROUTQ)
File : QCLSRC
Member : RTVOUTQAC
Type : CLP
Usage : CRTCLPGM RTVOUTQAC
/*-------------------------------------------------------------------*/
/* */
/* Program . . : RTVOUTQAC */
/* Description : Retrieve output queue attributes */
/* - CPP for RTVOUTQA */
/* */
/* Author . . : Vengoal Chang */
/* Date . . . : 2008/11/18 */
/* */
/* Compile options: */
/* CrtClPgm Pgm( RTVOUTQAC ) */
/* SrcFile( QCLSRC ) */
/* SrcMbr( *PGM ) */
/* */
/*-------------------------------------------------------------------*/
PGM PARM(&OUTQFULL &RTNLIB &DSPDTA &JOBSEP +
&OPRCTL &SEQ &AUTCHK &DTAQ &DTAQL +
&NBRFILES &QSTATUS &WTRNAM &WTRUSR +
&WTRNBR &WTRSTS &PRTDEV +
&MSGQ &MSGQL &RMTSYSNAMT &RMTSYSNAME +
&NBRWTRS &CNNTYPE &DESTTYPE &TRANSFORM +
&MFRTYPMDL &WSCST &WSCSTL &IMGCFG +
&CLASS &FCB &SEPPAGE &RMTPRTQ &TEXT)
DCL &OUTQFULL *CHAR LEN(20)
DCL &OUTQ *CHAR LEN(10)
DCL &LIB *CHAR LEN(10)
DCL &QLFDNAME *CHAR LEN(20)
DCL &LEN *CHAR LEN(4)
DCL &PARM *CHAR LEN(2000)
DCL &ERRCDE *CHAR LEN(4)
DCL &DEC9 *DEC LEN(9 0)
DCL &CHAR22 *CHAR LEN(22)
DCL &RTNLIB *CHAR LEN(10)
DCL &DSPDTA *CHAR LEN(4)
DCL &JOBSEP *CHAR LEN(4)
DCL &OPRCTL *CHAR LEN(4)
DCL &DTAQ *CHAR LEN(10)
DCL &DTAQL *CHAR LEN(10)
DCL &SEQ *CHAR LEN(7)
DCL &AUTCHK *CHAR LEN(7)
DCL &NBRFILES *DEC LEN(9 0)
DCL &QSTATUS *CHAR LEN(10)
DCL &WTRNAM *CHAR LEN(10)
DCL &WTRUSR *CHAR LEN(10)
DCL &WTRNBR *CHAR LEN(6)
DCL &WTRSTS *CHAR LEN(10)
DCL &PRTDEV *CHAR LEN(10)
DCL &MSGQ *CHAR LEN(10)
DCL &MSGQL *CHAR LEN(10)
DCL &RMTSYSNAMT *CHAR LEN(1)
/* 0 No remote system name specified */
/* 1 Output is routed to the system using pass-throug */
/* 2 The name of the remote system */
/* 3 Internet address */
DCL &RMTSYSNAME *CHAR LEN(255)
/* value based on the Remote System Name Type */
/* If 0 Blank */
/* If 1 Blank */
/* If 2 System name */
/* If 3 Internet address (15 bytes) */
DCL &NBRWTRS *DEC LEN(5 0)
DCL &CNNTYPE *CHAR LEN(10)
DCL &DESTTYPE *CHAR LEN(10)
DCL &TRANSFORM *CHAR LEN(4)
DCL &MFRTYPMDL *CHAR LEN(17)
DCL &WSCST *CHAR LEN(10)
DCL &WSCSTL *CHAR LEN(10)
DCL &IMGCFG *CHAR LEN(10)
DCL &CLASS *CHAR LEN(1)
DCL &FCB *CHAR LEN(10)
DCL &SEPPAGE *CHAR LEN(4)
DCL &RMTPRTQ *CHAR LEN(128)
DCL &TEXT *CHAR LEN(50)
DCL &WORKN *DEC LEN(5 0)
/*-- Global error monitoring: --------------------------------------*/
MonMsg CPF0000 *N GoTo Error
CHGVAR &OUTQ %SST(&OUTQFULL 1 10)
CHGVAR &LIB %SST(&OUTQFULL 11 10)
CHKOBJ OBJ(&LIB/&OUTQ) OBJTYPE(*OUTQ)
CHGVAR &QLFDNAME (&OUTQ *CAT &LIB)
CHGVAR %BIN(&LEN 1 4) 1000
CHGVAR %BIN(&ERRCDE 1 4) 0
/* Use API to access info */
CALL QSPROUTQ PARM(&PARM &LEN OUTQ0100 +
&QLFDNAME &ERRCDE)
RTNLIB: CHGVAR &RTNLIB %SST(&PARM 19 10)
MONMSG MSGID(MCH3601)
SEQ: CHGVAR &SEQ %SST(&PARM 29 10)
MONMSG MSGID(MCH3601)
DSPDTA: CHGVAR &DSPDTA %SST(&PARM 39 10)
MONMSG MSGID(MCH3601)
JOBSEP: CHGVAR &DEC9 %BIN(&PARM 49 4)
IF (&DEC9 *EQ -2) DO /* *MSG */
CHGVAR &JOBSEP '*MSG'
MONMSG MSGID(MCH3601)
ENDDO /* *MSG */
IF (&DEC9 *NE -2) DO /* Use digits */
CHGVAR &CHAR22 &DEC9
CHGVAR &JOBSEP &CHAR22
MONMSG MSGID(MCH3601)
ENDDO /* Use digits */
OPRCTL: CHGVAR &OPRCTL %SST(&PARM 53 10)
MONMSG MSGID(MCH3601)
DTAQ: CHGVAR &DTAQ %SST(&PARM 63 10)
MONMSG MSGID(MCH3601)
DTAQL: CHGVAR &DTAQL %SST(&PARM 73 10)
MONMSG MSGID(MCH3601)
AUTCHK: CHGVAR &AUTCHK %SST(&PARM 83 10)
MONMSG MSGID(MCH3601)
NBRFILES: CHGVAR &NBRFILES %BIN(&PARM 93 4)
MONMSG MSGID(MCH3601)
QSTATUS: CHGVAR &QSTATUS %SST(&PARM 97 10)
MONMSG MSGID(MCH3601)
WTRNAM: CHGVAR &WTRNAM %SST(&PARM 107 10)
MONMSG MSGID(MCH3601)
WTRUSR: CHGVAR &WTRUSR %SST(&PARM 117 10)
MONMSG MSGID(MCH3601)
WTRNBR: CHGVAR &WTRNBR %SST(&PARM 127 6)
MONMSG MSGID(MCH3601)
/* The following offsets do not agree */
/* with the V2R2 manual */
WTRSTS: CHGVAR &WTRSTS %SST(&PARM 133 10)
MONMSG MSGID(MCH3601)
PRTDEV: CHGVAR &PRTDEV %SST(&PARM 143 10)
MONMSG MSGID(MCH3601)
MSGQ: CHGVAR &MSGQ %SST(&PARM 601 10)
MONMSG MSGID(MCH3601)
MSGQL: CHGVAR &MSGQL %SST(&PARM 611 10)
MONMSG MSGID(MCH3601)
RMTSYSNAMT: CHGVAR &RMTSYSNAMT %SST(&PARM 217 1)
MONMSG MSGID(MCH3601)
RMTSYSNAME: CHGVAR &RMTSYSNAME %SST(&PARM 218 255)
MONMSG MSGID(MCH3601)
NBRWTRS: CHGVAR &NBRWTRS %BIN(&PARM 209 4)
MONMSG MSGID(MCH3601)
CNNTYPE: CHGVAR &WORKN %BIN(&PARM 621 4)
IF (&WORKN *EQ 0) DO
CHGVAR &CNNTYPE '*NONE'
MONMSG MSGID(MCH3601)
ENDDO
IF (&WORKN *EQ 1) DO
CHGVAR &CNNTYPE '*SNA'
MONMSG MSGID(MCH3601)
ENDDO
IF (&WORKN *EQ 2) DO
CHGVAR &CNNTYPE '*IP'
MONMSG MSGID(MCH3601)
ENDDO
IF (&WORKN *EQ 3) DO
CHGVAR &CNNTYPE '*IPX'
MONMSG MSGID(MCH3601)
ENDDO
IF (&WORKN *EQ 5) DO
CHGVAR &CNNTYPE '*USRDFN'
MONMSG MSGID(MCH3601)
ENDDO
DESTTYPE: CHGVAR &WORKN %BIN(&PARM 625 4)
IF (&WORKN *EQ 0) DO
CHGVAR &DESTTYPE '*NONE'
MONMSG MSGID(MCH3601)
ENDDO
IF (&WORKN *EQ 1) DO
CHGVAR &DESTTYPE '*OS400'
MONMSG MSGID(MCH3601)
ENDDO
IF (&WORKN *EQ 2) DO
CHGVAR &DESTTYPE '*OS400V2'
MONMSG MSGID(MCH3601)
ENDDO
IF (&WORKN *EQ 3) DO
CHGVAR &DESTTYPE '*S390'
MONMSG MSGID(MCH3601)
ENDDO
IF (&WORKN *EQ 4) DO
CHGVAR &DESTTYPE '*PSF2'
MONMSG MSGID(MCH3601)
ENDDO
IF (&WORKN *EQ 5) DO
CHGVAR &DESTTYPE '*PSF2'
MONMSG MSGID(MCH3601)
ENDDO
IF (&WORKN *EQ 6) DO
CHGVAR &DESTTYPE '*NETWARE3'
MONMSG MSGID(MCH3601)
ENDDO
IF (&WORKN *EQ 7) DO
CHGVAR &DESTTYPE '*NETWARE4'
MONMSG MSGID(MCH3601)
ENDDO
IF (&WORKN *EQ -1) DO
CHGVAR &DESTTYPE '*OTHER'
MONMSG MSGID(MCH3601)
ENDDO
TRANSFORM: IF (%SST(&PARM 638 1) *EQ '1') DO
CHGVAR &TRANSFORM '*YES'
MONMSG MSGID(MCH3601)
ENDDO
ELSE DO
CHGVAR &TRANSFORM '*NO'
MONMSG MSGID(MCH3601)
ENDDO
MFRTYPMDL: CHGVAR &MFRTYPMDL %SST(&PARM 639 17)
MONMSG MSGID(MCH3601)
WSCST: CHGVAR &WSCST %SST(&PARM 656 10)
MONMSG MSGID(MCH3601)
WSCSTL: CHGVAR &WSCSTL %SST(&PARM 666 10)
MONMSG MSGID(MCH3601)
IMGCFG: CHGVAR &IMGCFG %SST(&PARM 1074 10)
MONMSG MSGID(MCH3601)
CLASS: CHGVAR &CLASS %SST(&PARM 629 1)
MONMSG MSGID(MCH3601)
FCB: CHGVAR &FCB %SST(&PARM 630 8)
MONMSG MSGID(MCH3601)
SEPPAGE: IF (%SST(&PARM 818 1) *EQ '1') DO
CHGVAR &SEPPAGE '*YES'
MONMSG MSGID(MCH3601)
ENDDO
ELSE DO
CHGVAR &SEPPAGE '*NO'
MONMSG MSGID(MCH3601)
ENDDO
RMTPRTQ: CHGVAR &RMTPRTQ %SST(&PARM 819 255)
MONMSG MSGID(MCH3601)
TEXT: CHGVAR &TEXT %SST(&PARM 153 50)
MONMSG MSGID(MCH3601)
RMVMSG CLEAR(*ALL)
RETURN /* Normal end of program */
/*-- Error processor ------------------------------------------------*/
Error:
Call QMHMOVPM ( ' ' +
'*DIAG' +
x'00000001' +
'*PGMBDY ' +
x'00000001' +
x'0000000800000000' +
)
Call QMHRSNEM ( ' ' +
x'0000000800000000' +
)
EndPgm:
EndPgm
File : QCMDSRC
Member : RTVOUTQA
Type : CMD
Usage : CRTCMD CMD(RTVOUTQA) PGM(RTVOUTQAC) SRCFILE( YourSourceFile ) ALLOW(*IPGM *BPGM)
/* =============================================================== */
/* = Command....... RtvOutQA = */
/* = CPP........... RtvOutQA CLP = */
/* = Description... Retrieve Output Queue Attributes = */
/* = = */
/* = The RTVOUTQA command retrieves the information produced by = */
/* = the QSPROUTQ API. One or more parameters may be returned = */
/* = = */
/* = CrtCmd Cmd( RtvOutQA ) = */
/* = Pgm( RtvOutQAC ) = */
/* = SrcFile( YourSourceFile ) = */
/* = Allow(*Ipgm *Bpgm) = */
/* =============================================================== */
/* = Date : 2008/11/18 = */
/* = Author: Vengoal Chang = */
/* =============================================================== */
CMD PROMPT('Retrieve Out Queue Attr - TAA')
PARM KWD(OUTQ) TYPE(QUAL1) MIN(1) +
PROMPT('Output queue')
PARM KWD(RTNLIB) TYPE(*CHAR) LEN(10) RTNVAL(*YES) +
PROMPT('Actual library name (10)')
PARM KWD(DSPDTA) TYPE(*CHAR) LEN(4) RTNVAL(*YES) +
PROMPT('Display data (4)')
PARM KWD(JOBSEP) TYPE(*CHAR) LEN(4) RTNVAL(*YES) +
PROMPT('Job separator (4)')
PARM KWD(OPRCTL) TYPE(*CHAR) LEN(4) RTNVAL(*YES) +
PROMPT('Operator control (4)')
PARM KWD(SEQ) TYPE(*CHAR) LEN(7) RTNVAL(*YES) +
PROMPT('Qutput sequence (7)')
PARM KWD(AUTCHK) TYPE(*CHAR) LEN(7) RTNVAL(*YES) +
PROMPT('Authority check (7)')
PARM KWD(DTAQ) TYPE(*CHAR) LEN(10) RTNVAL(*YES) +
PROMPT('Data queue (10)')
PARM KWD(DTAQL) TYPE(*CHAR) LEN(10) RTNVAL(*YES) +
PROMPT('Data queue library (10)')
PARM KWD(NBRFILES) TYPE(*DEC) LEN(9 0) +
RTNVAL(*YES) +
PROMPT('Number of files (9 0)')
PARM KWD(QSTATUS) TYPE(*CHAR) LEN(10) +
RTNVAL(*YES) +
PROMPT('Output queue status (10)')
PARM KWD(WTRNAM) TYPE(*CHAR) LEN(10) +
RTNVAL(*YES) +
PROMPT('Writer job name (10)')
PARM KWD(WTRUSR) TYPE(*CHAR) LEN(10) +
RTNVAL(*YES) +
PROMPT('Writer user name (10)')
PARM KWD(WTRNBR) TYPE(*CHAR) LEN(6) +
RTNVAL(*YES) +
PROMPT('Writer job number (6)')
PARM KWD(WTRSTS) TYPE(*CHAR) LEN(10) +
RTNVAL(*YES) +
PROMPT('Writer status (10)')
PARM KWD(PRTDEV) TYPE(*CHAR) LEN(10) +
RTNVAL(*YES) +
PROMPT('Printer device name (10)')
PARM KWD(MSGQ) TYPE(*CHAR) LEN(10) +
RTNVAL(*YES) +
PROMPT('Message queue (10)')
PARM KWD(MSGQLIB) TYPE(*CHAR) LEN(10) +
RTNVAL(*YES) +
PROMPT('Message queue library (10)')
PARM KWD(RMTSYSNAMT) TYPE(*CHAR) LEN(1 ) +
RTNVAL(*YES) +
PROMPT('Remote system name type (1)')
PARM KWD(RMTSYSNAME) TYPE(*CHAR) LEN(255) +
RTNVAL(*YES) +
PROMPT('Remote system name type (255)')
PARM KWD(NBRWTRS) TYPE(*DEC ) LEN(5 0) +
RTNVAL(*YES) +
PROMPT('Number of writers (5 0)')
PARM KWD(CNNTYPE) TYPE(*CHAR) LEN(10) +
RTNVAL(*YES) +
PROMPT('Connection type (10)')
PARM KWD(DESTTYPE) TYPE(*CHAR) LEN(10) +
RTNVAL(*YES) +
PROMPT('Destination type (10)')
PARM KWD(TRANSFORM) TYPE(*CHAR) LEN( 4) +
RTNVAL(*YES) +
PROMPT('Transformon (4)')
PARM KWD(MFRTYPMDL) TYPE(*CHAR) LEN(17) +
RTNVAL(*YES) +
PROMPT('Manufacture Type and Model(17)')
PARM KWD(WSCST ) TYPE(*CHAR) LEN(10) +
RTNVAL(*YES) +
PROMPT('Workstation CST Object (10)')
PARM KWD(WSCSTL ) TYPE(*CHAR) LEN(10) +
RTNVAL(*YES) +
PROMPT('Workstation CST Object Lib(10)')
PARM KWD(IMGCFG ) TYPE(*CHAR) LEN(10) +
RTNVAL(*YES) +
PROMPT('Image configuration (10)')
PARM KWD(CLASS ) TYPE(*CHAR) LEN(1 ) +
RTNVAL(*YES) +
PROMPT('VM/VMS class (1)')
PARM KWD(FCB ) TYPE(*CHAR) LEN(10) +
RTNVAL(*YES) +
PROMPT('Forms control buffer (10)')
PARM KWD(SEPPAG ) TYPE(*CHAR) LEN( 4) +
RTNVAL(*YES) +
PROMPT('Separator page (4)')
PARM KWD(RMTPRTQ ) TYPE(*CHAR) LEN(128) +
RTNVAL(*YES) +
PROMPT('Remote printer queue (128)')
PARM KWD(TEXT) TYPE(*CHAR) LEN(50) RTNVAL(*YES) +
PROMPT('Text description (50)')
QUAL1: QUAL TYPE(*NAME) LEN(10) MIN(1) EXPR(*YES)
QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) +
SPCVAL((*LIBL)) EXPR(*YES) +
PROMPT('Library name')
File : QCLSRC
Member : RTVOUTQAT
Type : CLP
Usage : CRTCLPGM RTVOUTQAT
測試程式 CALL RTVOUTQAT
PGM
DCL &AUTCHK *CHAR 7
DCL &JOBSEP *CHAR 4
DCL &OPRCTL *CHAR 4
DCL &MSG *CHAR 256
DCL &NBRFILES *DEC 9 0
DCL &NBRFILESC *CHAR 9
DCL &MSGQ *CHAR 10
DCL &MSGQL *CHAR 10
DCL &TRANSFORM *CHAR 4
DCL &CNNTYPE *CHAR 10
DCL &DSTTYPE *CHAR 10
DCL &SEPPAGE *CHAR 10
DCL &RMTSYSTYPE *CHAR 1
RTVOUTQA OUTQ(QPRINT) JOBSEP(&JOBSEP) OPRCTL(&OPRCTL) +
AUTCHK(&AUTCHK) NBRFILES(&NBRFILES) +
MSGQ(&MSGQ) MSGQLIB(&MSGQL) +
RMTSYSNAMT(&RMTSYSTYPE) CNNTYPE(&CNNTYPE) +
DESTTYPE(&DSTTYPE) TRANSFORM(&TRANSFORM) +
SEPPAG(&SEPPAGE)
CHGVAR &NBRFILESC &NBRFILES
CHGVAR &MSG (&JOBSEP *BCAT &OPRCTL *BCAT &NBRFILESC)
DMPCLPGM
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA(&MSG) +
MSGTYPE(*COMP)
ENDPGM
星期二, 11月 07, 2023
2006-02-22 如何針移動整個 outq 的報表至另一個outq ?(Command PRCSLTSPLF)
如何針移動整個 outq 的報表至另一個outq ?(Command PRCSLTSPLF)
工具: PRCSLTSPLF(Process selected spool files)
此工具整合 MOVSPLF, HLDSPLF, DLTSPLF, RLSSPLF
The Process Selected Spool Files Utility
下載 Source code
/*==================================================================*/
/* Process a group of spool files */
/*==================================================================*/
/* To compile: */
/* */
/* CRTCMD CMD(XXX/PRCSLTSPLF) PGM(XXX/SPL001CL) + */
/* SRCFILE(XXX/QCMDSRC) */
/* */
/*==================================================================*/
CMD PROMPT('Process selected spool files')
PARM KWD(FROMOUTQ) TYPE(Q1) PROMPT('From output +
queue')
Q1: QUAL TYPE(*NAME) LEN(10) MIN(1) EXPR(*YES)
QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) +
SPCVAL((*LIBL) (*CURLIB)) EXPR(*YES) +
PROMPT('Library')
PARM KWD(ACTION) TYPE(*CHAR) LEN(3) RSTD(*YES) +
DFT(MOV) VALUES(DLT HLD MOV RLS) +
EXPR(*YES) PROMPT('Action')
PARM KWD(FILE) TYPE(*NAME) LEN(10) DFT(*ALL) +
SPCVAL((*ALL)) EXPR(*YES) PROMPT('File name')
PARM KWD(FORMTYPE) TYPE(*NAME) LEN(10) DFT(*ALL) +
SPCVAL((*ALL) (*STD)) EXPR(*YES) +
PROMPT('Form type')
PARM KWD(USERDATA) TYPE(*NAME) LEN(10) DFT(*ALL) +
SPCVAL((*ALL)) EXPR(*YES) PROMPT('User data')
PARM KWD(USERID) TYPE(*NAME) LEN(10) DFT(*ALL) +
SPCVAL((*ALL)) EXPR(*YES) PROMPT('User +
profile')
PARM KWD(DATE) TYPE(*DATE) DFT(*ALL) SPCVAL((*ALL +
010140)) PROMPT('Creation date')
PARM KWD(TOOUTQ) TYPE(Q1) PMTCTL(OUTQ2) +
PROMPT('To output queue')
OUTQ2: PMTCTL CTL(ACTION) COND((*EQ MOV))
/*==================================================================*/
/* CPP for PRCSLTSPLF command */
/*==================================================================*/
/* To compile: */
/* */
/* CRTCLPGM PGM(XXX/SPL001CL) SRCFILE(XXX/QCLSRC) */
/* */
/*==================================================================*/
PGM PARM(&FROMOUTQ &ACTION &SELFILE &SELFORM +
&SELUSRDTA &SELUSER &SELDATE &TOOUTQ)
DCL &ACOUNT *CHAR 5
DCL &ACTION *CHAR 3
DCL &COUNT *DEC 5
DCL &DONE *CHAR 10
DCL &ERROR *LGL VALUE('0')
DCL &ERRBYTES *CHAR 4 VALUE(X'00000000')
DCL &ERRORDATA *CHAR 80
DCL &ERRORID *CHAR 7
DCL &FROMOUTQ *CHAR 20
DCL &FROMOUTQLI *CHAR 10
DCL &FROMOUTQNA *CHAR 10
DCL &MSGKEY *CHAR 4
DCL &MSGTYP *CHAR 10 VALUE('*DIAG')
DCL &MSGTYPCTR *CHAR 4 VALUE(X'00000001')
DCL &PGMMSGQ *CHAR 10 VALUE('*')
DCL &SELDATE *CHAR 7
DCL &SELFILE *CHAR 10
DCL &SELFORM *CHAR 10
DCL &SELUSER *CHAR 10
DCL &SELUSRDTA *CHAR 10
DCL &SPLFDATE *CHAR 7
DCL &SPLFFILE *CHAR 10
DCL &SPLFJOBNAM *CHAR 10
DCL &SPLFJOBNBR *CHAR 6
DCL &SPLFJOBUSR *CHAR 10
DCL &SPLFNBR *CHAR 6
DCL &STKCTR *CHAR 4 VALUE(X'00000001')
DCL &TOOUTQ *CHAR 20
DCL &TOOUTQLIB *CHAR 10
DCL &TOOUTQNAME *CHAR 10
MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERRPROC))
CHGVAR VAR(&FROMOUTQNA) VALUE(&FROMOUTQ)
CHGVAR VAR(&FROMOUTQLI) VALUE(%SST(&FROMOUTQ 11 10))
CHKOBJ OBJ(&FROMOUTQLI/&FROMOUTQNA) OBJTYPE(*OUTQ)
IF COND(&ACTION *EQ MOV) THEN(DO)
CHGVAR VAR(&TOOUTQNAME) VALUE(&TOOUTQ)
CHGVAR VAR(&TOOUTQLIB) VALUE(%SST(&TOOUTQ 11 10))
CHKOBJ OBJ(&TOOUTQLIB/&TOOUTQNAME) OBJTYPE(*OUTQ)
ENDDO
GETENTRY:
CALL PGM(SPL001RG) PARM(&FROMOUTQ &SELFORM +
&SELUSRDTA &SELUSER &SELDATE &SELFILE +
&SPLFFILE &SPLFJOBNBR &SPLFJOBUSR +
&SPLFJOBNAM &SPLFNBR &SPLFDATE &ERRORID &ERRORDATA)
IF COND(&ERRORID *NE ' ') THEN(DO)
SNDPGMMSG MSGID(&ERRORID) MSGF(QCPFMSG) +
MSGDTA(&ERRORDATA) MSGTYPE(*ESCAPE)
ENDDO
IF COND(&SPLFFILE *EQ '**********') THEN(GOTO +
CMDLBL(ENDENTRY))
IF COND(&ACTION *EQ MOV) THEN(DO)
CHGSPLFA FILE(&SPLFFILE) +
JOB(&SPLFJOBNBR/&SPLFJOBUSR/&SPLFJOBNAM) +
SPLNBR(&SPLFNBR) OUTQ(&TOOUTQLIB/&TOOUTQNAME)
CHGVAR VAR(&COUNT) VALUE(&COUNT + 1)
CHGVAR VAR(&DONE) VALUE('moved')
ENDDO
ELSE CMD(IF COND(&ACTION *EQ DLT) THEN(DO))
DLTSPLF FILE(&SPLFFILE) +
JOB(&SPLFJOBNBR/&SPLFJOBUSR/&SPLFJOBNAM) +
SPLNBR(&SPLFNBR)
CHGVAR VAR(&COUNT) VALUE(&COUNT + 1)
CHGVAR VAR(&DONE) VALUE('deleted')
ENDDO
ELSE CMD(IF COND(&ACTION *EQ HLD) THEN(DO))
HLDSPLF FILE(&SPLFFILE) +
JOB(&SPLFJOBNBR/&SPLFJOBUSR/&SPLFJOBNAM) +
SPLNBR(&SPLFNBR)
CHGVAR VAR(&COUNT) VALUE(&COUNT + 1)
CHGVAR VAR(&DONE) VALUE('held')
ENDDO
ELSE CMD(IF COND(&ACTION *EQ RLS) THEN(DO))
RLSSPLF FILE(&SPLFFILE) +
JOB(&SPLFJOBNBR/&SPLFJOBUSR/&SPLFJOBNAM) +
SPLNBR(&SPLFNBR)
CHGVAR VAR(&COUNT) VALUE(&COUNT + 1)
CHGVAR VAR(&DONE) VALUE('released')
ENDDO
GOTO CMDLBL(GETENTRY)
ENDENTRY:
IF COND(&COUNT *EQ 0) THEN(DO)
CHGVAR VAR(&ACOUNT) VALUE('0')
ENDDO
ELSE CMD(DO)
CHGVAR VAR(&ACOUNT) VALUE(&COUNT)
RADJ:
IF COND(%SST(&ACOUNT 1 1) *EQ '0') THEN(DO)
CHGVAR VAR(&ACOUNT) VALUE(%SST(&ACOUNT 2 4))
GOTO CMDLBL(RADJ)
ENDDO
ENDDO
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA('Spool +
files' *BCAT &DONE *TCAT ':' *BCAT +
&ACOUNT) MSGTYPE(*COMP)
RETURN
/*==================================================================*/
/* Error processing routine */
/*==================================================================*/
ERRPROC:
IF COND(&ERROR) THEN(GOTO CMDLBL(ERRDONE))
ELSE CMD(CHGVAR VAR(&ERROR) VALUE('1'))
/* Move all *DIAG messages to previous program queue */
CALL PGM(QMHMOVPM) PARM(&MSGKEY &MSGTYP +
&MSGTYPCTR &PGMMSGQ &STKCTR &ERRBYTES)
/* Resend last *ESCAPE message */
ERRDONE:
CALL PGM(QMHRSNEM) PARM(&MSGKEY &ERRBYTES)
MONMSG MSGID(CPF0000) EXEC(DO)
SNDPGMMSG MSGID(CPF3CF2) MSGF(QCPFMSG) +
MSGDTA('QMHRSNEM') MSGTYPE(*ESCAPE)
MONMSG MSGID(CPF0000)
ENDDO
ENDPGM
*===============================================================
* Return information about a spool file. Used by PRCSLTSPLF.
*===============================================================
* To compile:
* CRTRPGPGM PGM(XXX/SPL001RG) SRCFILE(XXX/QRPGSRC)
*
*===============================================================
* API error data structure
IAPIERR DS
I B 1 40ERRPRV
I B 5 80ERRAVL
I 9 15 ERRID
I 17 96 ERRPDT
* API general header
IAPIHDR DS
I B 125 1280GUSOFF
I B 133 1360GUSNBE
I B 137 1400GUSLEN
* Spool file header data, SPLF0200 format
ISPLHDR DS
I 1 10 SPHUSR
I 11 20 SPHOTQ
I 21 30 SPHOQL
I 31 40 SPHFRM
I 41 50 SPHUDT
I B 83 860SPHNKY
I 87 102 SPHNU1
I 103 112 SPHNAM
* Spool file header data for fields
ISPLHD2 DS
I 21 30 SPANAM
I 49 58 SPAJOB
I 77 86 SPAUSR
I 105 110 SPAJBN
I B 129 1320SPANUM
I 149 155 SPDATE
* Data structure to define binary variables
I DS
I B 1 40SPLKEY
I B 5 80GUSSPO
I B 9 120GUSHLN
I B 13 160SPSIZE
I B 17 200SPALRV
* Binary DS for QUSLSPL list of keys
I DS
I 1 24 SPLK
I B 1 40SPLK1
I B 5 80SPLK2
I B 9 120SPLK3
I B 13 160SPLK4
I B 17 200SPLK5
I B 21 240SPLK6
*
I '#SPLFWORK#QTEMP 'C USRSPN
C *ENTRY PLIST
C PARM I#OUTQ 20 output queue
C PARM I#FORM 10 form
C PARM I#USRD 10 user data
C PARM I#USNM 10 user name
C PARM I#DATE 7 creation date
C PARM I#FILE 10 file name
C PARM O#FILE 10 file name
C PARM O#JBNR 6 job number
C PARM O#JBUS 10 user profile
C PARM O#JBNM 10 job name
C PARM O#SPNR 6 spool file nbr
C PARM O#SPDT 7 creation date
C PARM O#ERID 7 Error msg ID
C PARM O#ERDT 80 Error msg data
*
* Process next spool file entry
*
C SELECT DOUEQ'1'
C MOVE '1' SELECT 1
C ADD 1 ENTRCT 90
C ENTRCT IFLE GUSNBE
* Get the attributes of the spooled file
C CALL 'QUSRTVUS'
C PARM SPACNM
C PARM GUSSPO
C PARM GUSLEN
C PARM SPLHD2
C PARM APIERR
C EXSR CHKERR
C I#DATE IFNE '0400101'
C I#DATE ANDNESPDATE
C MOVE '0' SELECT
C ENDIF
C I#FILE IFNE '*ALL'
C I#FILE ANDNESPANAM
C MOVE '0' SELECT
C ENDIF
C SELECT IFEQ '1'
C MOVELSPANAM O#FILE file name
C MOVELSPAJOB O#JBNM job name
C MOVELSPAUSR O#JBUS user ID
C MOVE SPAJBN O#JBNR job number
C MOVE SPDATE O#SPDT creation date
C MOVE SPANUM O#SPNR file number
C ENDIF
C ADD GUSLEN GUSSPO goto next entry
C ELSE
C MOVE *ALL'*' O#FILE
C MOVE *ON *INLR
C ENDIF
C ENDDO
*
C RETRN
* =========================================================
C *INZSR BEGSR
*
C MOVE *BLANKS O#ERID
* Create the user space
C CALL 'QUSCRTUS'
C PARM USRSPN SPACNM 20
C PARM SPATTR 10
C PARM 8192 SPSIZE
C PARM X'00' SPIVAL 1
C PARM '*CHANGE' SPAUTH 10
C PARM SPTEXT 50
C PARM '*YES' SPREPL 10
C PARM APIERR
C EXSR CHKERR
*
* initialize user space list variables
C Z-ADD6 SPLKEY
C Z-ADD201 SPLK1 file name
C Z-ADD202 SPLK2 job name
C Z-ADD203 SPLK3 user name
C Z-ADD204 SPLK4 job number
C Z-ADD205 SPLK5 spool file nbr
C Z-ADD216 SPLK6 creation date
C CALL 'QUSLSPL'
C PARM SPACNM 20 usrspc name
C PARM 'SPLF0200'SPFMT 8 format
C PARM I#USNM SPUSNM 10 user name
C PARM I#OUTQ SPOUTQ 20 output queue
C PARM I#FORM SPFORM 10 formtype
C PARM I#USRD SPUSRD 10 user data
C PARM APIERR
C PARM *BLANKS SPLJBN 26 job name
C PARM SPLK
C PARM SPLKEY
C EXSR CHKERR
*
* Get User Space Detail Parameter list
C Z-ADD140 GUSHLN
C CLEARAPIHDR
* Get header data from user space
C Z-ADD1 GUSSPO
C CALL 'QUSRTVUS'
C PARM SPACNM
C PARM 1 GUSSPO
C PARM GUSHLN
C PARM APIHDR
C PARM APIERR
C EXSR CHKERR
*
C GUSOFF ADD 1 GUSSPO
C CALL 'QUSRTVUS'
C PARM SPACNM
C PARM GUSSPO
C PARM GUSHLN
C PARM SPLHDR
C PARM APIERR
C EXSR CHKERR
*
C ENDSR
* =========================================================
C CHKERR BEGSR
*
C ERRID IFNE *BLANKS
C MOVELERRID O#ERID
C MOVELERRPDT O#ERDT
C MOVE *ON *INLR
C RETRN
C ENDIF
*
C ENDSR
訂閱：
文章 (Atom)