contact image


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