|
 |
Read Outq with API
This program uses the API QUSLSPL to read through all spooled files in a outqueue.
The outqueue names are supplied by physical file DAILYOUTQP.
The spool file attributes are retrieved and used as keys to chain to physical file
MONITORP. This file holds the PDF and HTML name for the spooled file after conversion.
Well basically that’s it. we currently use tools from
RJSSoftware and
BVSTools. But there are examples on this
site to help you convert to .PDF and .HTML without them. I would recommend
picking up the tools from BVSTools they
are very inexpensive and work flawlessly.
WHY:
We display all reports from end of day on our local Intranet.
This allows local and remote users instant access to reports.
This also allows the user to print(.PDF) if they desire on their home PC’s.
Remote users must VPN into network to access the intranet, this acts as basic
security.
DOWNLOAD
Download text files
-
Read through outqueue with API and process the spooled files.
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=--=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
* Program Name: SNDIFSFTPR
* Description : Send IFS File to FTP
* Written On :
*
*
* Modification
* ~~~~~~~~~~~~
* Date Project Pgmr Description
* ~~~~~~~~ ~~~~~~~ ~~~~ ~~~~~~~~~~~
*
*
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-===-=-=-=-=-=-=-=-=-
H option(*srcstmt: *nodebugio) dftactgrp(*no)
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-===-=-=-=-=-=-=-=-=-
*
* Daily Reports OutQ
* ~~~~~~~~~~~~~~~~~~
FDAILYOUTQPif e k disk prefix(d) usropn
*
* Monitor outq MIS03p Create webpages
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
FMONITORP uf e k disk usropn
*
* FTP Daily Reports Command
* ~~~~~~~~~~~~~~~~~~~~~~~~~
FFTPDRPTCMDuf e k disk usropn
*
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-===-=-=-=-=-=-=-=-=-
*
* 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
* ~~~
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
*
* Subprocedure(s)
* ~~~~~~~~~~~~~~~
D $GetDoW pr 3A
D InpDate d value
*
* 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 inz(0)
D pos1 s 4 0 inz(0)
*
D CmdString s 12500 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)
D TodayDoW s 3 inz(*blanks)
*
D SPLFDate s d datfmt(*iso)
D TodayDate s d datfmt(*iso)
D YesterDayDate s d datfmt(*iso)
D LastSaturday s d datfmt(*iso)
D LastFriDay s d datfmt(*iso)
D cYMDDate s 6 inz(*blanks)
*
D ProgramName s 10 inz(*blanks)
D FormName s 10 inz(*blanks)
*
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-===-=-=-=-=-=-=-=-=-
* MAIN PROGRAM
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-===-=-=-=-=-=-=-=-=-
*
C if not %open(MONITORP)
C open MONITORP
C endif
*
C if not %open(DAILYOUTQP)
C open DAILYOUTQP
C endif
*
C *start setll DAILYOUTQP
C read DAILYOUTQP
C dow not %eof(DAILYOUTQP)
*
C eval OutQ = dOUTQ
C eval OutQLib = dOUTQLIB
C exsr $GetSPLFList
*
C read DAILYOUTQP
C enddo
*
C if %open(MONITORP)
C close MONITORP
C endif
*
C if %open(DAILYOUTQP)
C close DAILYOUTQP
C endif
*
* Send e-mail
*
C exsr $SendEML
*
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
*
C eval cYMDDate = %subst(dsSF.OpenDate : 2)
C eval SPLFDate = %date(cYMDDate : *ymd0)
C if (SPLFDate = TodayDate or
C (SPLFDate = YesterdayDate and
C dsSF.OpenTime >= '230000')) or
C ((TodayDoW = 'MON') and
C ((SPLFDate = LastSaturday) or
C (SPLFDate = LastFriDay and
C dsSF.OpenTime >= '230000')))
C exsr $ValidSPLF
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
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=--=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
* $ValidSPLF - Validate Spool Files again MONITORP
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=--=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
C $ValidSPLF 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
C MONITORPKey chain MONITORP
C if %found(MONITORP)
*
* Release Spooled File
*
C if (dsSF.SplfStatus = 6)
C eval CmdString = %trim('RLSSPLF') +
c %trim('~FILE(')+%trim(wSPLFName)+%trim(')')+
C %trim('~JOB(') + %trim(JobInfo) + %trim(')')+
C %trim('~SPLNBR(') +
C %trim(%char(dsSF.SplfNbr)) + %trim(')')
C eval CmdString = %xlate('~' : ' ' : CmdString)
C eval CmdLength = %len(%trim(CmdString))
C call 'QCMDEXC' 99
C parm CmdString
C parm CmdLength
C endif
*
* Convert Spooled File to HTML File
*
C if HTML = 'Y' and WEBPAGE <> *blanks
C exsr $CnvSPLF2HTM
C endif
*
* Convert Spooled File to PDF file
*
C if PDF = 'Y' and PDFNAME <> *blanks
C exsr $CnvSPLF2PDF
C endif
*
* Update MONITORP
*
C eval USEDDATE = %date()
C eval SNUMBER = dsSF.JobNumber
C eval SSNUMBER = %char(dsSF.SplfNbr)
C update MONR
*
C endif
*
C endsr
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-==-
* $CnvSPLF2HTM - Convert Report to HTML
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-==-
C $CnvSPLF2HTM begsr
*
C eval CmdString = %trim('SPLTOOL/SPL2STMF') +
c %trim('~FILE(')+%trim(wSPLFName)+%trim(')')+
C %trim('~JOB(') + %trim(JobInfo) + %trim(')')+
C %trim('~SPLNBR(*LAST)') +
C %trim('~FROM(*FIRST)') +
C %trim('~TO(*LAST)') +
C %trim('~TOSTMF(') + %trim('''') +
C %trim(WEBPAGE) + %trim('''') + %trim(')')+
C %trim('~DIR(') + %trim('''') +
C %trim(FOLDER) + %trim('''') + %trim(')') +
C %trim('~RPLF(*YES)')
C eval CmdString = %xlate('~' : ' ' : CmdString)
C eval CmdLength = %len(%trim(CmdString))
C call 'QCMDEXC' 99
C parm CmdString
C parm CmdLength
*
* FTP HTML File
*
C eval IFSFName = %trim('/') + %trim(FOLDER) +
C %trim(WEBPAGE)
C eval FTPFName = %trim(WEBPAGE)
C exsr $ChgFTPFName
C exsr $SndFTP
C exsr $DLTOvrDBF
C exsr $ChgFTPFName2
*
C endsr
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-==-
* $CnvSPLF2PDF - Convert Report to PDF
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-==-
C $CnvSPLF2PDF begsr
*
* Convert Report in SPLF to PDF
*
C eval IFSPDFName = %trim(FOLDER) +
C %trim(PDFName)
*
C eval CmdString = %trim('AFPTOOL/AFPTOOL') +
c %trim('~FILE(')+%trim(wSPLFName)+%trim(')')+
C %trim('~JOB(') + %trim(JobInfo) + %trim(')')+
C %trim('~SPLNBR(*LAST)') +
C %trim('~STMF(') + %trim('''') +
C %trim(IFSPDFName) + %trim(''')') +
C %trim('~REPLACE(*YES)') +
C %trim('~ORIENT(*Land)') +
C %trim('~CVTFAC(0.195)')
C eval CmdString = %xlate('~' : ' ' : CmdString)
C eval CmdLength = %len(%trim(CmdString))
C call 'QCMDEXC' 99
C parm CmdString
C parm CmdLength
*
* FTP PDF File
*
C eval IFSFName = %trim('/') + %trim(FOLDER) +
C %trim(PDFName)
C eval FTPFName = %trim(PDFName)
C exsr $ChgFTPFName
C exsr $SndFTP
C exsr $DLTOvrDBF
C exsr $ChgFTPFName2
*
C endsr
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-==-
* $ChgFTPFName - Change FTP File Name
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-==-
C $ChgFTPFName begsr
*
* Open FTP Command File
*
C if not %open(FTPDRPTCMD)
C open FTPDRPTCMD
C endif
*
C *start setll FTPDRPTCMD
C read FTPDRPTCMD
C dow not %eof(FTPDRPTCMD)
*
* scan for originated file name
*
C eval pos = %scan('&orgobj' : FTPCMD)
C if pos > 0
C eval FTPCMD = %subst(%trim(FTPCMD) : 1 : pos-1) +
C %trim(IFSFName) +
C %subst(%trim(FTPCMD) : pos+7)
C endif
*
* scan for destination file name
*
C eval pos = %scan('&desobj' : FTPCMD)
C if pos > 0
C eval FTPCMD = %subst(%trim(FTPCMD) : 1 : pos-1) +
C %trim(FTPFName)
C endif
*
C update FTPCmdR
C read FTPDRPTCMD
C enddo
*
C if %open(FTPDRPTCMD)
C close FTPDRPTCMD
C endif
*
C endsr
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-==-
* $ChgFTPFName2 - Change FTP File Name
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-==-
C $ChgFTPFName2 begsr
*
* Open FTP Command File
*
C if not %open(FTPDRPTCMD)
C open FTPDRPTCMD
C endif
*
C *start setll FTPDRPTCMD
C read FTPDRPTCMD
C dow not %eof(FTPDRPTCMD)
*
* scan for originated file name
*
C eval pos = %scan(%trim(IFSFName) : FTPCMD)
C if pos > 0
C eval pos1 = (pos + %len(%trim(IFSFName)))
C eval FTPCMD = %subst(%trim(FTPCMD) : 1 : pos-1) +
C %trim('&orgobj') +
C %subst(%trim(FTPCMD) : pos1)
C endif
*
* scan for destination file name
*
C eval pos = %scan(%trim(FTPFName) : FTPCMD)
C if pos > 0
C eval FTPCMD = %subst(%trim(FTPCMD) : 1 : pos-1) +
C %trim('&desobj')
C endif
*
C update FTPCmdR
C read FTPDRPTCMD
C enddo
*
C if %open(FTPDRPTCMD)
C close FTPDRPTCMD
C endif
*
C endsr
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-==-
* $SndFTP - Send FTP File
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-==-
C $SndFTP begsr
*
C eval CmdString = %trim('OVRDBF~FILE(INPUT)') +
C %trim('~TOFILE(CGI_BIN/FTPDRPTCMD)') +
C %trim('~OVRSCOPE(*JOB)')
C eval CmdString = %xlate('~' : ' ' : CmdString)
C eval CmdLength = %len(%trim(CmdString))
C call 'QCMDEXC'
C parm CmdString
C parm CmdLength
*
C eval CmdString = %trim('STRTCPFTP') +
C %trim('~RMTSYS(ftp.code400.com)')
C eval CmdString = %xlate('~' : ' ' : CmdString)
C eval CmdLength = %len(%trim(CmdString))
C call 'QCMDEXC' 99
C parm CmdString
C parm CmdLength
*
C endsr
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-==-
* $DLTOvrDBF - Delete Source Physical File.
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-==-
C $DLTOvrDBF begsr
*
C eval CmdString = %trim('DLTOVR') +
C %trim('~FILE(*ALL)') +
C %trim('~LVL(*JOB)')
C eval CmdString = %xlate('~' : ' ' : CmdString)
C eval CmdLength = %len(%trim(CmdString))
C call 'QCMDEXC' 99
C parm CmdString
C parm CmdLength
*
C endsr
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-==-
* $SendEMLCmd - Send e-mail.
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-==-
C $SendEMLCmd begsr
*
C eval CmdString = %trim('SMTPTEXT') +
C %trim('~TOADDR(') + %trim(EMLAddress) +
C %trim(')') +
C %trim('~SUBJECT(') + %trim('''') +
C %trim(EMLSubject) + %trim('''') + %trim(')')+
C %trim('~MSGFILE(JJFLIB/DREPORTS)') +
C %trim('~SMTPHOST(MAIL.CODE400.COM)')
C eval CmdString = %xlate('~' : ' ' : CmdString)
C eval CmdLength = %len(%trim(CmdString))
C call 'QCMDEXC' 99
C parm CmdString
C parm CmdLength
*
C endsr
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-==-
* $SendEMLCmd2 - Send e-mail.
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-==-
C $SendEMLCmd2 begsr
*
C eval CmdString = %trim('SMTPTEXT') +
C %trim('~TOADDR(') + %trim(EMLAddress) +
C %trim(')') +
C %trim('~SUBJECT(') + %trim('''') +
C %trim(EMLSubject) + %trim('''') + %trim(')')+
C %trim('~MSGFILE(JJFLIB/DREPORTS_M)') +
C %trim('~SMTPHOST(MAIL.CODE400.COM)')
C eval CmdString = %xlate('~' : ' ' : CmdString)
C eval CmdLength = %len(%trim(CmdString))
C call 'QCMDEXC' 99
C parm CmdString
C parm CmdLength
*
C endsr
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-==-
* $SendEML - Send e-mail.
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-==-
C $SendEML begsr
*
C
C eval EMLAddress = %trim('jamief@code400.com')
C exsr $SendEMLCmd
*
C endsr
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-===-=-=-=-=-=-=-=-=-
* Initialization
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-===-=-=-=-=-=-=-=-=-
C *inzsr begsr
*
* Key Lists
*
C MONITORPKey klist
C kfld wJobName
C kfld wSPLFName
C kfld wUserData
*
C RUSHTMLPKey klist
C kfld ProgramName
C kfld FormName
*
* Add Library List
*
C eval CmdString = %trim('ADDLIBLE') +
C %trim('~LIB(AFPTOOL)') +
C %trim('~POSITION(*LAST)')
C eval CmdString = %xlate('~' : ' ' : CmdString)
C eval CmdLength = %len(%trim(CmdString))
C call 'QCMDEXC' 99
C parm CmdString
C parm CmdLength
*
C eval CmdString = %trim('ADDLIBLE') +
C %trim('~LIB(SPLTOOL)') +
C %trim('~POSITION(*LAST)')
C eval CmdString = %xlate('~' : ' ' : CmdString)
C eval CmdLength = %len(%trim(CmdString))
C call 'QCMDEXC' 99
C parm CmdString
C parm CmdLength
*
C eval CmdString = %trim('ADDLIBLE') +
C %trim('~LIB(RJSSMTP)') +
C %trim('~POSITION(*LAST)')
C eval CmdString = %xlate('~' : ' ' : CmdString)
C eval CmdLength = %len(%trim(CmdString))
C call 'QCMDEXC' 99
C parm CmdString
C parm CmdLength
*
C eval CmdString = %trim('ADDLIBLE') +
C %trim('~LIB(CGI_BIN)') +
C %trim('~POSITION(*LAST)')
C eval CmdString = %xlate('~' : ' ' : CmdString)
C eval CmdLength = %len(%trim(CmdString))
C call 'QCMDEXC' 99
C parm CmdString
C parm CmdLength
*
C eval TodayDate = %date()
C eval YesterdayDate = (TodayDate - %days(1))
C eval TodayDoW = $GetDoW(TodayDate)
C eval TodayDoW = %xlate(Low : Up : TodayDoW)
C if TodayDoW = 'MON'
C eval LastSaturday = (TodayDate - %days(2))
C eval LastFriDay = (TodayDate - %days(3))
C endif
*
C endsr
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-===-=-=-=-=-=-=-=-=-
* $GetDoW - Get Day of Week
* 1=Sun, 2=Mon, etc.
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-===-=-=-=-=-=-=-=-=-
P$GetDoW b
D $GetDoW pi 3a
D InpDate d value
*
D DayOfWk s 11p 0
D AnySundayDate s d datfmt(*iso)
D inz(d'1998-08-01')
D WrkDate s d datfmt(*iso)
D DoWDesc s 3 inz(*blanks)
*
C eval WrkDate = InpDate
C eval DayOfWk = %diff(InpDate:AnySundayDate:*days)
C div 7 DayOfWk
C mvr DayOfWk
*
C if DayOfWk <= 0
C eval DayOfWk = (DayOfWk + 7)
C endif
*
C select
C when DayOfWk = 1
C eval DoWDesc = 'Sun'
C when DayOfWk = 2
C eval DoWDesc = 'Mon'
C when DayOfWk = 3
C eval DoWDesc = 'Tue'
C when DayOfWk = 4
C eval DoWDesc = 'Wed'
C when DayOfWk = 5
C eval DoWDesc = 'Thu'
C when DayOfWk = 6
C eval DoWDesc = 'Fri'
C when DayOfWk = 7
C eval DoWDesc = 'Sat'
C endsl
*
C return DoWDesc
*
P$GetDoW e
|
