Use api to get spooled file information



    RPGLE  - Use api to get spooled file information

    
     FMONITORP  UF   E           K DISK
     FDAILYP    iF   E           K DISK
     F*
     F* Source file to write new daily reports HTM to
     F*
     FDAILY     O    E             DISK    UsrOPn Prefix(X) Rename(DAILY:DLY)
     F*
      * PROGRAM STATUS DATA
     D                SDS
     D  PGMID                  1     10
     D  USERID               254    263
      * DATA QUEUE LAYOUT
     D QDATA           DS           128    INZ
     D  RCDID                  1     10
     D*                                      11  12 ??
     D  JOBID                 13     38
     D  JOBNM                 13     22
     D  JOBUSER               23     32
     D  JOBNBR                33     38
     D  SPLF                  39     48
     D  BSPLF#                49     52B 0
     D  OUTQ                  53     62
     D  OTQLIB                63     72
     D*                                      73 128 ??
     D* QUSRSPLA - LIST SPOOL FILE ATRIBUTES API
     D*                                      73 128 ??
     D RCVVAR          DS                  INZ
     D  BYTRTN                 1      4B 0
     D  BYTVAL                 5      8B 0
     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
      * DEFINE BINANRY NUMBERS
     D                 DS
     D  RCVLEN                 1      4B 0
      * DEFINE CONSTANTS

     D ISODate         S               D
     D TodayISO        S               D
     D Available       S              1
     D DEC155          S             15  5
     D Dec8            S             08  0
     D Chr8            S             08
     D Chr4            S             04
     D Chr2            S             02
     D Chr8_2          S             08
     D Out8            S             08
     D C1DAY           S             09
     D Str             S             02  0
     D Year            S             04  0
     D ChrYear         S             04
     D Month           S             02  0
     D Day             S             02  0
     D ChrDay          S             02
     D Len             S             05  0
     D Next            S             05  0
     D Today           S             50
     D WorkField       S              5  0
     D MName           S            256
     D CmdString       S            256
     D CmdLength       S             15  5
     D DayOfWeek       S             07  0
     D*
     D* Days
     D*
     D DNames          S             63    Inz('Sunday   Monday   Tuesday  Wedn+
     D                                     esdayThursday Friday   Saturday ')
     D*
     D* Months
     D*
     D MNames          S            108    Inz('January  FebruraryMarch    Apri+
     D                                     l    May      June     July     +
     D                                     August   SeptemberOctober  Nove+
     D                                     mber December ')
     D*=====================================================================
     D*   Commands for QCMDEXC
     D*=====================================================================
     D*
     D* CLRPFM FILE(CGI_BIN/DAILY) MBR(DAILY)
     D*
     D CLRPFM          DS
     D Text1                   1     25    Inz('CLRPFM FILE(CGI_BIN/DAILY')
     D Text2                  26     37    Inz(') MBR(DAILY)')
     D*
     D* OVRDBF FILE(DAILY) TOFILE(CGI_BIN/DAILY) MBR(DAILY)
     D*
     D OVRDBF          DS
     D Text3                   1     27    Inz('OVRDBF FILE(DAILY)  TOFILE')
     D Text4                  27     53    Inz('(CGI_BIN/DAILY) MBR(DAILY)')
     D*
     D* CPYTOSTMF FROMMBR('/QSYS.LIB/CGI_BIN.LIB/DAILY.FILE/DAILY.MBR')
     D*           TOSTMF('/WEB/REPORTS/20020602/DailyReports.htm')
     D*          STMFOPT(*REPLACE) STMFCODPAG(*PCASCII)
     D*
     D*
     D**************************************************************
      *  MAIN LINE - RTV DATA QUEUE
     D**************************************************************
     C*
     C                   Exsr      $Daily
     C*
     C                   MOVE      *ON           *INLR
     C**************************************************************
      * SUBROUTINES:

     C**************************************************************
      * RETRIVE SPOOL FILE ATTRIBUTES

     C**************************************************************
     C     $RTVA         BEGSR
      *  CALL SYSTEM API
     C                   CALL      'QUSRSPLA'                           99
     C                   PARM                    RCVVAR
     C                   PARM      100           RCVLEN
     C                   PARM      'SPLA0100'    FMTNM             8
     C                   PARM                    JOBID            26
     C                   PARM      *BLANK        INTJOB           16
     C                   PARM      *BLANK        INTSPL           16
     C                   PARM                    SPLF
     C                   PARM                    BSPLF#
     C*
     C                   Select
     C                   When      JOB = 'QPRT160'
     C     WebKey2       Chain     MONITORP
     C                   Other
     C     WebKey1       Chain     MONITORP
     C                   Endsl
     C*
     C                   If        %Found(MONITORP)
     C*
     C                   Move      TodayISO      UsedDate
     C*
     C* last spooled info
     C*
     C                   Movel(p)  FILNAM        SFILE
     C                   Movel(p)  JOBNAM        SJOB
     C                   Movel(p)  USRNAM        SUSER
     C                   Movel(p)  JOBNUM        SNUMBER
     C                   Move      FILNUM        SSNUMBER
     C*
     C                   Do        5             Str
     C                   If        %Subst(SSNUMBER:Str:1) <> '0'
     C                   Leave
     C                   Else
     C                   Eval      %Subst(SSNUMBER:Str:1) = *Blanks
     C                   Endif
     C                   Enddo
     C*
     C                   Eval      SSNUMBER = %Trim(SSNUMBER)
     C*
     C                   Movel(p)  USRDTA        SUSERDATA
     C*
     C                   Update    MONR
     C*
     C     *MDY          Move      UDATE         ISODate
     C                   Move      ISODate       Dec8
     C                   Move      Dec8          Chr8_2
     C                   Subdur    1:*days       ISODate
     C                   Move      ISODate       Dec8
     C                   Move      Dec8          Chr8
     C                   Move      Chr8          Out8
     C*
     C                   Z-add     BSPLF#        Dec155
     C*
     C                   Eval      USRDTA = %Trim(USRDTA)
     C                   Call      'MONITORC2'                          99
     C                   Parm                    SPLF
     C                   Parm                    JOBNM
     C                   Parm                    JOBUSER
     C                   Parm                    JOBNBR
     C                   Parm                    DEC155
     C                   Parm                    WEBPAGE
     C                   Parm                    FOLDER
     C                   Parm                    Chr8
     C                   Parm                    HTML
     C                   Parm                    PDF
     C                   Parm                    EMAIL
     C                   Parm                    EADDRESS
     C                   Parm                    ESUBJECT
     C                   Parm                    ENOTE1
     C                   Parm                    Chr8_2
     C*
     C                   Endif
     C*
     C                   ENDSR
     C*==================================================================
     C* $Daily - Daily Reports
     C*==================================================================
     CSR   $Daily        Begsr
     C*
     C* Redundant date functions so that I can test
     C*
     C     *MDY          Move      UDATE         ISODate
     C                   Move      ISODate       Dec8
     C                   Move      Dec8          Chr8_2
     C                   Subdur    1:*days       ISODate
     C                   Move      ISODate       Dec8
     C                   Move      Dec8          Chr8
     C                   Move      Chr8          Out8
     C*
     C* Create string for today
     C*
     C*
     C                   Eval      Year  = %Subdt(ISODate:*Y)
     C                   Move      Year          ChrYear
     C                   Eval      Month = %Subdt(ISODate:*M)
     C                   Eval      Day   = %Subdt(ISODate:*D)
     C                   Move      Day           ChrDay
     C                   Exsr      $Day
     C                   Eval      Month = Month -1
     C                   Eval      MName = %Trim(%Subst(MNames:(Month*9):9))
     C                   Clear                   Today
     C                   Eval      Today  = %Trim(C1DAY) + '%The%'
     C                             + %Trim(ChrDay) + %Trim('%Of%')
     C                             + %Trim(MName) + %Trim('%The Year Of%')
     C                             + %Trim(ChrYear)
     C*
     C     '%':' '       Xlate     Today         Today
     C*
     C     *Start        Setll     DAILYP
     C                   Read      DAILYP
     C                   Dow       Not%Eof(DAILYP)
     C*
     C     '@@DATE'      Scan      DFIELD        Str
     C                   If        %Found
     C                   Eval      %Subst(DFIELD:Str:50) = Today
     C                   Endif
     C*
     C     '$$$$$$$$'    Scan      DFIELD        Str
     C                   If        %Found
     C                   Eval      %Subst(DFIELD:Str:08) = Chr8
     C                   Endif
     C*
     C     '%%%%%%%%'    Scan      DFIELD        Next
     C                   If        %Found
     C                             And Next > *Zeros
     C                   Eval      %Subst(DFIELD:Next:08) = Chr8
     C                   Endif
     C*
     C*
     C                   Movel(p)  DFIELD        XSRCDTA
     C*
     C*
     C                   Write     DLY
     C*
     C                   Read      DAILYP
     C                   Enddo
     C*
     C* Close the source member and then send it somewhere
     C*
     C                   If        %Open(DAILY)
     C                   Close     DAILY
     C                   Endif
     C*
     C*
     C* CPYTOSTMF FROMMBR('/QSYS.LIB/CGI_BIN.LIB/DAILY.FILE/DAILY.MBR')
     C*           TOSTMF('/WEB/REPORTS/20020602/DailyReports.htm')
     C*          STMFOPT(*REPLACE) STMFCODPAG(*PCASCII)
     C*
     C                   Eval      CmdString =%Trim('CPYTOSTMF FROMMBR(')  +
     C                                          %Trim('''')                +
     C                                          %Trim('/QSYS.LIB/CGI_BIN') +
     C                                          %Trim('.LIB/DAILY.FILE/D') +
     C                                          %Trim('AILY.MBR')          +
     C                                          %Trim('''')                +
     C                                          %Trim(') TOSTMF(')         +
     C                                          %Trim('''')                +
     C                                          %Trim('/WEB/REPORTS/')     +
     C                                          %Trim(Chr8)                +
     C                                          %Trim('/DailyReports.htm') +
     C                                          %Trim('''')                +
     C                                          %Trim(')')                 +
     C                                          %Trim('!STMFCODPAG(*PCAS') +
     C                                          %Trim('CII)')              +
     C                                          %Trim('!STMFOPT(*REPLACE)')
     C     '!':' '       Xlate     CmdString     CmdString
     C*
     C                   Eval      Len = %Len(%Trim(CmdString))
     C                   Call      'QCMDEXC'                            88
     C                   Parm                    CmdString
     C                   Parm      Len           CmdLength
     C*
     C*
     C                   Endsr
     C*==================================================================
     C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-==-
     C* $Day - What Day is Today.
     C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-==-
     C     $Day          Begsr
     C*
     C*
     C     IsoDate       Subdur    D'1899-12-30' DayofWeek:*D
     C                   Div       7             DayOfWeek
     C                   Mvr                     DayOfWeek
     C*
     C                   If        DayOfWeek < 1.
     C                   Eval      DayOfWeek = DayOfWeek + 7.
     C                   Endif
     C*
     C                   Select
     C                   When      DayOfWeek = 1.
     C                   Movel(p)  'Sunday'      C1DAY
     C                   When      DayOfWeek = 2.
     C                   Movel(p)  'Monday'      C1DAY
     C                   When      DayOfWeek = 3.
     C                   Movel(p)  'Tuesday'     C1DAY
     C                   When      DayOfWeek = 4.
     C                   Movel(p)  'Wednesday'   C1DAY
     C                   When      DayOfWeek = 5.
     C                   Movel(p)  'Thursday'    C1DAY
     C                   When      DayOfWeek = 6.
     C                   Movel(p)  'Friday'      C1DAY
     C                   When      DayOfWeek = 7.
     C                   Movel(p)  'Saturday'    C1DAY
     C                   Endsl
     C*
     C*
     C                   Endsr
**************************************************************************
     C     *INZSR        BEGSR
      * ENTRY PARMS
      * RECEIVE DATA QUEUE PARMS
      * DEFINE VARIABLES
     C*
     C*  Klist
     C*
     C     WebKey1       Klist
     C                   Kfld                    JOBNM
     C                   Kfld                    SPLF
     C*
     C     WebKey2       Klist
     C                   Kfld                    JOBNM
     C                   Kfld                    SPLF
     C                   Kfld                    USRDTA
     C*
     C     *MDY          Move      UDATE         TodayISO
     C*
     C*Set up member to write to
     C*
     C*
     C* Build the DSM model(s)
     C*
     C                   Movel(p)  CLRPFM        CmdString
     C                   Eval      Len = %Len(%Trim(CmdString))
     C                   Call      'QCMDEXC'                            88
     C                   Parm                    CmdString
     C                   Parm      Len           CmdLength
     C*
     C                   Movel(p)  OVRDBF        CmdString
     C                   Eval      Len = %Len(%Trim(CmdString))
     C                   Call      'QCMDEXC'                            88
     C                   Parm                    CmdString
     C                   Parm      Len           CmdLength
     C*
     C                   If        Not%Open(DAILY)
     C                   Open      DAILY
     C                   Endif
     C*
     C                   ENDSR

No comments