Tweet
Code:
Ã? *======================================================================= Ã?
Ã? * Program Name: APISPL Ã?
Ã? * Description : Read thru outqueue move spooled files if ITSTATUS in Ã?
Ã? * ITOUTQP <> *Blanks Ã?
Ã? * Written On : Ã?
Ã? * Ã?
Ã? * Ã?
Ã? * Modification Ã?
Ã? * ~~~~~~~~~~~~ Ã?
Ã? * Date Project Pgmr Description Ã?
Ã? * ~~~~~~~~ ~~~~~~~ ~~~~ ~~~~~~~~~~~ Ã?
Ã? *June 22,2004 Ã?
Ã? * Ã?
Ã? *======================================================================== Ã?
h option(*srcstmt: *nodebugio) dftactgrp(*no)
fITOUTQP if e k disk
Ã? * Ã?
Ã? * Program Info Ã?
Ã? * Ã?
d PgmInfo SDS
d @PgmName 1 10
d @Parms 37 39 0
d @MsgID 40 46
d @JobName 244 253
d @UserId 254 263
d @JobNbr 264 269 0
Ã? * Ã?
Ã? * API - List spooled files Ã?
Ã? * Ã?
d QUSLSPL PR extpgm('QUSLSPL')
Ã? * required parameters Ã?
d UsrSpc 20A const
d Format 8A const
d UserName 10A const
d QualOutQ 20A const
d FormType 10A const
d UserData 10A const
Ã? * optional group 1: Ã?
d ErrorCode 32766A options(*nopass: *varsize)
Ã? * optional group 2: Ã?
d QualJob 26A options(*nopass) const
d FieldKeys 10I 0 options(*nopass: *varsize)
d dim(9999)
d NumFields 10I 0 options(*nopass) const
Ã? * optional group 3: Ã?
d AuxStgPool 10I 0 options(*nopass) const
Ã? * optional group 4: Ã?
d JobSysName 8A options(*nopass) const
d StartCrtDate 7A options(*nopass) const
d StartCrtTime 6A options(*nopass) const
d EndCrtDate 7A options(*nopass) const
d EndCrtTime 6A options(*nopass) const
Ã? * Ã?
d QUSCRTUS PR extpgm('QUSCRTUS')
d UsrSpc 20A const
d ExtAttr 10A const
d InitialSize 10I 0 const
d InitialVal 1A const
d PublicAuth 10A const
d Text 50A const
d Replace 10A const
d ErrorCode 32766A options(*nopass: *varsize)
Ã? * Ã?
d QUSPTRUS PR extpgm('QUSPTRUS')
d UsrSpc 20A const
d Pointer *
Ã? * Ã?
d QUSDLTUS PR extpgm('QUSDLTUS')
d UsrSpc 20A const
d ErrorCode 32766A options(*varsize)
Ã? * Ã?
d p_UsrSpc s *
d dsLH DS based(p_UsrSpc)
d qualified
d Filler1 103A
d Status 1A
d Filler2 12A
d HdrOffset 10I 0
d HdrSize 10I 0
d ListOffset 10I 0
d ListSize 10I 0
d NumEntries 10I 0
d EntrySize 10I 0
Ã? * Ã?
d p_Entry s *
d dsSF DS based(p_Entry)
d qualified
d JobName 10A
d UserName 10A
d JobNumber 6A
d SplfName 10A
d SplfNbr 10I 0
d SplfStatus 10I 0
d OpenDate 7A
d OpenTime 6A
d Schedule 1A
d SysName 10A
d UserData 10A
d FormType 10A
d OutQueue 10A
d OutQueueLib 10A
d AuxPool 10I 0
d SplfSize 10I 0
d SizeMult 10I 0
Ã? * Ã?
d TotalPages 10I 0
d CopiesLeft 10I 0
d Priority 1A
d Reserved 3A
Ã? * Ã?
d dsEC DS qualified
d BytesProvided 10I 0 inz(%size(dsEC))
d BytesAvail 10I 0 inz(0)
d MessageID 7A
d Reserved 1A
d MessageData 240A
Ã? * Ã?
Ã? * constants Ã?
Ã? * Ã?
d MYSPACE c const('SPLFLIST QTEMP ')
d Low c const('abcdefghijklmnopqrstuvwxyz')
d Up c const('ABCDEFGHIJKLMNOPQRSTUVWXYZ')
Ã? * Ã?
Ã? * Field Definitions. Ã?
Ã? * Ã?
d OutQName ds
d OutQ 10A inz(*blanks)
d OutQLib 10A inz(*blanks)
Ã? * Ã?
d size s 10I 0
d sf s 10I 0 inz(1)
d pos s 4 0
d pos1 s 4 0
d Len s 4 0
d Loop s 1 inz('Y')
Ã? * Ã?
d CmdString s 256 inz(*blanks)
d CmdLength s 15 5 inz(0)
Ã? * Ã?
d IFSPDFName s 2500 inz(*blanks)
d IFSHTMName s 2500 inz(*blanks)
d JobInfo s 256 inz(*blanks)
d IFSFName s 256 inz(*blanks)
d FTPFName s 256 inz(*blanks)
d wSPLFName s 10 inz(*blanks)
d wJobName s 10 inz(*blanks)
d wUserData s 10 inz(*blanks)
d EMLSubject s 256 inz(*blanks)
d EMLMessage s 15000 inz(*blanks)
d EMLAddress s 256 inz(*blanks)
Ã? * Ã?
Ã? *======================================================================== Ã?
Ã? * MAIN LINE Ã?
Ã? *======================================================================== Ã?
Ã? * Ã?
Ã? * Read thru the ITOUTQ table and look for ITSTATUS <> *Blanks Ã?
Ã? * If found then use the To-OutQueue and Library to move the spooled Files Ã?
Ã? * Ã?
c dow Loop = 'Y'
Ã? * Ã?
c *start setll ITOUTQP
c read ITOUTQP
c dow not %eof(ITOUTQP)
Ã? * Ã?
c if ITSTATUS <> *blanks
c eval OutQ = ITFOUTQ
c eval OutQLib = ITFOLIB
c exsr $GetSPLFList
c endif
Ã? * Ã?
Ã? * Delay the job for 5 minutes Ã?
Ã? * Ã?
c eval CmdString = 'DLYJOB 300'
c eval CmdLength = %Len(%Trim(CmdString))
c call(e) 'QCMDEXC'
c parm CmdString
c parm CmdLength
Ã? * Ã?
c read ITOUTQP
c enddo
Ã? * Ã?
c enddo
c eval *inlr = *on
c return
Ã? *======================================================================== Ã?
Ã? * $GetSPLFList - Get Spooled File List Ã?
Ã? *======================================================================== Ã?
c $GetSPLFList begsr
Ã? * Ã?
Ã? * set this to zero to let OS/400 handle errors Ã?
Ã? * Ã?
c eval dsEC.BytesProvided = 0
Ã? * Ã?
Ã? * Make space for (approx) 1000 spooled files to be listed Ã?
Ã? * Ã?
c eval size = %size(dsLH) + 512 +
c (%size(dsSF) * 1000)
Ã? * Ã?
Ã? * Create a user space Ã?
Ã? * List spooled files to the user space Ã?
Ã? * Get a pointer to the returned user space Ã?
Ã? * Ã?
/free
// Create a user space
QUSCRTUS(MYSPACE: 'USRSPC': size: x'00': '*ALL':
'Temp User Space for QUSLSPL API': '*YES': dsEC);
// List spooled files to the user space
QUSLSPL(MYSPACE: 'SPLF0300': '*ALL': OutQName:
'*ALL': '*ALL': dsEC);
// Get a pointer to the returned user space
QUSPTRUS(MYSPACE: p_UsrSpc);
/end-free
Ã? * Ã?
Ã? * Loop through list, for each spooled file, display the Ã?
Ã? * Status: 1=RDY , 2=OPN, 3=CLO, 4=SAV, 5=WRT, 6=HLD, Ã?
Ã? * 7=MSGW, 8=PND, 9=PRT,10=FIN,11=SND,12=DFR Ã?
Ã? * Ã?
c eval p_Entry = p_UsrSpc + dsLH.ListOffset
c eval sf = 1
c dow sf <= dsLH.NumEntries
Ã? * Ã?
Ã? * currently only move status = 1 ready Ã?
Ã? * Ã?
c if dsSF.SplfStatus = 1
c exsr $MoveSplf
c endif
Ã? * Ã?
c eval p_Entry = p_Entry + dsLH.EntrySize
c eval sf = (sf + 1)
c enddo
Ã? * Ã?
Ã? * delete user space Ã?
Ã? * Ã?
/free
QUSDLTUS(MYSPACE: dsEC);
/end-free
Ã? * Ã?
Ã? * Ã?
c endsr
Ã? *======================================================================== Ã?
Ã? * $MoveSplF - Move the spooled file Ã?
Ã? *======================================================================== Ã?
c $MoveSPlf begsr
Ã? * Ã?
c eval JobInfo =
c %trim(dsSF.JobNumber) +
c %trim('/') + %trim(dsSF.UserName) +
c %trim('/') + %trim(dsSF.JobName)
Ã? * Ã?
c eval wSPLFName = dsSF.SplfName
c eval wJobName = dsSF.JobName
c eval wUserData = dsSF.UserData
Ã? * Ã?
Ã? * Move the spool file Ã?
Ã? * CHGSPLFA FILE(QPSUPRTF) JOB(546777/FLANARY/QPADEV0041) Ã?
Ã? * SPLNBR(*LAST) CRTDATE(*LAST) OUTQ(JAMIELIB/JAMIEOUT) Ã?
Ã? * Ã?
c eval CmdString = %trim('CHGSPLFA') +
c %trim('~FILE(')+%trim(wSPLFName)+%trim(')')+
c %trim('~JOB(') + %trim(JobInfo) + %trim(')')+
c %trim('~SPLNBR(') +
c %trim(%char(dsSF.SplfNbr)) + %trim(')')
c + ' OUTQ(' + %Trim(ITTOLIB) + %trim('/') +
c %trim(ITTOUTQ) + %trim(')')
c eval CmdString = %xlate('~' : ' ' : CmdString)
c eval CmdLength = %len(%trim(CmdString))
Ã? * Ã?
Ã? * Move the spooled file ... Ã?
Ã? * Ã?
c call(e) 'QCMDEXC'
c parm CmdString
c parm CmdLength
Ã? * Ã?
Ã? * Do the actual move of the spooled file Ã?
Ã? * Ã?
c eval Len = %len(%trim(CmdString))
Ã? * Ã?
c call(e) 'QCMDEXC'
c parm CmdString
c parm Len CmdLength
Ã? * Ã?
Ã? * Ã?
c endsr
Ã? *======================================================================== Ã?
Ã? * Initialization Ã?
Ã? *======================================================================== Ã?
c *inzsr begsr
Ã? * Ã?
Ã? * Ã?
c endsr