Re: moving spool files
d spec = definition
c spec = calculation
d spec = definition
c spec = calculation
// this is a character array (any length without a decimal position value // is assumed to be a character field. the DIM() keyword indicates that // this is an array d CStack 10 Dim(10) // this is a zoned decimal field zoned is denoted by the "s" after the length d s s 2s 0 // this is a 1 byte character field which can be determined as i noted on the // CStack field. d z s 1 // the previous field could also be defined like this: d z s 1a // this is an indicator field DWriteFlag s Like(*INLR) // this is another way to define an indicator field DWriteFlag s n // this is a packed decimal field d packed s 5 0 // this is another way to define a packed decimal field d packed s 5p 0
PGM DCL VAR(&DATE ) TYPE(*CHAR) LEN(6) DCL VAR(&JUL ) TYPE(*CHAR) LEN(5) DCL VAR(&JULDAY) TYPE(*CHAR) LEN(4) DCL VAR(&OUTQ ) TYPE(*CHAR) LEN(10) RTVSYSVAL SYSVAL(QDATE) RTNVAR(&DATE) CVTDAT DATE(&DATE) TOVAR(&JUL) FROMFMT(*SYSVAL) + TOFMT(*JUL) TOSEP(*NONE) CHGVAR VAR(&JULDAY) VALUE(%SST(&JUL 3 3)) CHGVAR VAR(&OUTQ) VALUE('WD' *CAT &JULDAY) CALL PGM(PIPER/MOVEOUTQ) PARM('PROD' + 'PIPER' 'PROD' '&OUTQ') ENDPGM
CALL PGM(PIPER/MOVEOUTQ) PARM('PROD' + 'PIPER' 'PROD' &OUTQ)
d myoutq s 10 d julian s d datfmt(*JUL) inz * *======================================================================== * MAIN LINE *======================================================================== * c eval julian = %date() c [COLOR=royalblue]eval myoutq = 'Q' + %char(julian:*jul0)[/COLOR] * c eval *inlr = *on
d MOVEOUTQR pr d inFlibrary 10 d inFoutq 10 d inTlibrary 10 d inToutq 10 d MOVEOUTQR pi d inFlibrary 10 d inFoutq 10 d inTlibrary 10 d inToutq 10 *
*=================================================== * PROGRAM - * PURPOSE - * WRITTEN - * AUTHOR - * * PROGRAM DESCRIPTION * * * * INPUT PARAMETERS * Description Type Size How Used * ----------- ---- ---- -------- * InObject Char 10 Object (*ALL) * InLibary Char 10 Library to search for objects * InType Char 10 Type of objects to dump * * INDICATOR USAGE * 03 - Cancel current screen and return to previous screen * 30 - SFLCLR * 31 - SFLDSP * 32 - SFLDSPCTL * 33 - SFLEND * *=================================================== FQSYSPRT O F 132 PRINTER OFLIND(*INOF) * * Program Info * d SDS d @PGM 1 10 d @PARMS 37 39 0 d @JOB 244 253 d @USER 254 263 d @JOB# 264 269 0 * * Field Definitions. * d AllText s 10 Inz('*ALL') d bOvr s 1a inz('0') d CmdString s 256 d CmdLength s 15 5 d Count s 4 0 d CYMD s 7 0 d Fmt s 8a inz('MBRD0200') d Format s 8 d GenLen s 8 d Howmany s 8 0 d InLibrary s 10 d InObject s 10 d InType s 10 d ISoDate s D d Low c CONST('abcdefghijklmnopqrstuvwxyz') d ObjectLib s 20 d OutNumber s 10 d memberName s 10 inz('*FIRST') d P1deleted s 8 0 d P1created s 8 0 d P1changed s 8 0 d P1desc s 50 d P1Records s 8 0 d SpaceVal s 1 inz(*BLANKS) d SpaceAuth s 10 inz('*CHANGE') d SpaceText s 50 inz(*BLANKS) d SpaceRepl s 10 inz('*YES') d SpaceAttr s 10 inz(*BLANKS) d Up c CONST('ABCDEFGHIJKLMNOPQRSTUVWXYZ') d USA s 8 0 d UserSpaceOut s 20 À * Ä À * GenHdr Ä À * Ä d GenHdr ds inz d OffSet 1 4B 0 d NumEnt 9 12B 0 d Lstsiz 13 16B 0 À * Ä À * Data structures Ä À * Ä d GENDS ds d OffsetHdr 1 4B 0 d NbrInList 9 12B 0 d SizeEntry 13 16B 0 * * * d HeaderDs ds d OutFileNam 1 10 d OutLibName 11 20 d OutType 21 25 d OutFormat 31 40 d RecordLen 10i 0 * * API Error Data Structure * d ErrorDs DS INZ d BytesPrv 1 4B 0 d BytesAvl 5 8B 0 d MessageId 9 15 d ERR### 16 16 d MessageDta 17 116 * * Create userspace datastructure * d DS d StartPosit 1 4B 0 d StartLen 5 8B 0 d SpaceLen 9 12B 0 d ReceiveLen 13 16B 0 d MessageKey 17 20B 0 d MsgDtaLen 21 24B 0 d MsgQueNbr 25 28B 0 * * Date structure for retriving userspace info * d InputDs DS d UserSpace 1 20 d SpaceName 1 10 d SpaceLib 11 20 d InpFileLib 29 48 d InpFFilNam 29 38 d InpFFilLib 39 48 d InpRcdFmt 49 58 * d ObjectDs ds d Object 10 d Library 10 d ObjectType 10 d InfoStatus 1 d ExtObjAttrib 10 d Description 50 À * Ä * Create a userspace * c exsr $QUSCRTUS * * List all the objects to the user space * c if inobject = *blanks c eval inobject = '*' c endif * c eval Format = 'OBJL0200' c eval objectlib = InObject + InLibrary * c call(e) 'QUSLOBJ' c parm Userspace UserSpaceOut c parm Format c parm ObjectLib c parm InType * * Retrive header entry and process the user space * c eval StartPosit = 125 c eval StartLen = 16 * * Retrive header entry and process the user space * c call 'QUSRTVUS' c parm UserSpace UserSpaceOut c parm StartPosit c parm StartLen c parm GENDS * c eval StartPosit = OffsetHdr + 1 c eval StartLen = %size(ObjectDS) * À * Do for number of fields Ä * c z-add NbrInList HowMany B1 c do NbrInList * * c call(e) 'QUSRTVUS' c parm UserSpace UserSpaceOut c parm StartPosit c parm StartLen c parm ObjectDs * * display outqueue name * c object dsply reply 1 * c eval StartPosit = StartPosit + SizeEntry c enddo * c eval *Inlr = *On *=============================================== * $QUSCRTUS - API to create user space *=============================================== c $QUSCRTUS begsr * * Create a user space named ListObjects in QTEMP. * c Eval BytesPrv = 116 c movel(p) 'LISTOBJECTS' SpaceName c movel(p) 'QTEMP' SpaceLib * * Create the user space * c call(e) 'QUSCRTUS' c parm UserSpace UserSpaceOut c parm SpaceAttr c parm 4096 SpaceLen c parm SpaceVal c parm SpaceAuth c parm SpaceText c parm SpaceRepl c parm ErrorDs * c endsr *================================================= * *Inzsr - One time run House keeping subroutine *================================================= c *Inzsr begsr * c *entry plist c parm InObject c parm InLibrary c parm InType * c eval InObject = c %xlate(Low:Up:InObject) c eval InLibrary = c %xlate(Low:Up:InLibrary) c eval InType = c %xlate(Low:Up:InType) * c endsr *==============================================
call listoutqs parm('*ALL' 'QUSRSYS' '*OUTQ')
Comment