ibmi-brunch-learn

Announcement

Collapse
No announcement yet.

ISeries CL Retrieve creation date from spool file

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • ISeries CL Retrieve creation date from spool file

    I am a new programmer to the as400, and I need to create a CL program that will check a printer queue for any spool files and then for any spool file, get the creation date of that spool file to see if its older than 30 minutes. I can't seem to find any documentation for what I am trying to do. I have seen the API QUSRSPLA, but im not sure if this is what im looking for, nor can I seem to find any good usage documentation about how to call the api and then fill a variable with a creation date to use for comparing. If anyone has a program that does what im trying to do or a suggestion, it would be greatly appreciated.

    **EDIT**

    For a more clear understanding of what I need to do I wanted to explain in more detail what I need.

    I need a CL program, that will grab all of the spool files from a specific printer. Once it has them all it will loop through each one, grabbing the creation date and time of the spool file, and filling a variable with it. Then a comparison will be done to check if the creation date and time is older than 30 minutes from current date and time. If it is older, then a message will need to be sent out. The message part I'm not sure about, since I'll need a way to monitor for the message, but ill worry about that part later on.

    Thank you to everyone who has looked at this and is trying to help out.
    Last edited by Ascidious; February 19, 2019, 03:48 PM.

  • #2
    If you have access to something that can run SQL, and assuming you don't actually have an antique AS/400, there's an IBMi Service for that. Where PRINTER is the name of the printer.
    Code:
    select *
      from QSYS2.OUTPUT_QUEUE_ENTRIES
      where OUTPUT_QUEUE_NAME = 'PRINTER'
        and CREATE_TIMESTAMP < current_timestamp - 30 minutes

    Comment


    • Ascidious
      Ascidious commented
      Editing a comment
      Thanks for the reply, the as400 we use is currently model E4C, and the operating system we are on is V7R1.0, if thats helpful.

      Can the SQL statement be used inside of the CL program? because i needto be able to set up the program to run every so often to check for the spools files that match the criteria.

  • #3
    I think you've probably got a POWER7 server running IBMi 7.1, rather than an AS/400. IBMi 7.1 is no longer supported, and I don't think OUTPUT_QUEUE_ENTRIES was ever released for that version of the OS. That means that using SQL from CL is probably a moot point.

    Comment


    • Ascidious
      Ascidious commented
      Editing a comment
      Hmm, do you know of any CL program, where I could maybe create a array of spool files from the specific printer, and then loop through each one, to see if it has existed for longer than 30 minutes?

  • #4
    Another option would be to specify a Data Queue to be associated with the Output Queue and then read the contents of he DTAQ via QRCVDTAQ to determine when a spool file is generated. This link gives you an overview...its a little bit of work...but a very versatile solution

    Comment


    • #5
      I'd be curious to know what you're trying to accomplish - in other words, why do you want to know about spool files created more than 30 minutes ago?

      Cheers,

      Emmanuel

      Comment


      • Ascidious
        Ascidious commented
        Editing a comment
        We currently have a printer that loves to get hung up and needs to be manually kicked so we can restart it. However there are multiple reasons this happens and each reason has a unique way we need to reset it, so that can't be done programmatically. So what we want to do is have a program that runs and checks for spool files and if any are other than 30 minutes we know that that particular printer is hanging up and needs to be reset, so we will send out a message telling us to reset that printer.

    • #6
      There is a third party toolset for the iSeries called TAATOOLS. One of the included tools is a command called RTVSPLFA, which is basically a command wrapper for the QUSRSPLA API. https://www.taatools.com/document/L_rtvsplfa.html
      It would be easy to call this command from CL to get the data you needed. Check, maybe you already have this toolset installed on your iSeries. I think it's fairly common (both of the companies I have worked at had it).

      Without access to TAATOOLS, I would write an RPGLE program to call the API and get the required info, and call that from the CL (calling API's from CL is much more difficult than calling from RPGLE).
      I found an example elsewhere on this forum of an RPG program calling the QUSRSPLA API: http://www.code400.com/forum/forum/i...ccl-from-rpgle
      Your first time coding an API call can be challenging, but the experience will be worth it in the future.

      Comment


      • Ascidious
        Ascidious commented
        Editing a comment
        Thank you for your comment, unfortunately it looks like RTVSPLFA does not have a parameter for creation date and time, which is really what I need to pull from the spool file.

    • #7
      so here you go -- like killing a mosquito with a canon!!!
      Look specifically for subroutine: $GetSPLFList

      PHP Code:
           H dftactgrp( *no OPTION(*NODEBUGIOACTGRP('MONITOR')                                        
           
      H bnddir'QC2LE':'UTILITIES')                                                                 

           
      F********************************************************************                          
           
      fsycontrol if   e           k disk    usropn                                                   
            
      *                                                                                             
            * 
      Defined variables                                                                           
            
      *                                                                                             
           
      d AEJobIsRunning...                                                                            
           
      d                 s               n   inz('0')                                                 
           
      d AEJobIsOnHold...                                                                             
           
      d                 s               n   inz('0')                                                 
           
      d AllText         s             10    Inz('*ALL')                                              
           
      d AnySunday       s               d   inz(D'1999-06-13')                                       
           
      d backendjobname  s              4    inz                                                      
           d BackHalf        s            256    inz varying                                              
           d CRLF            c                   
      CONST(X'0d25')                                           
           
      d CreateDateISO   s               D                                                            
           d CT
      #             s             10i 0 inz                                                      
           
      d Currenttime     s               t   inz                                                      
           d DayOfWeek       s             10i 0 inz                                                      
           d DecimalJobNumber
      ...                                                                          
           
      d                 s              8  0 inz                                                      
           d DecimalSpoolNumber
      ...                                                                        
           
      d                 s              6  0 inz                                                      
           d defaultemailaddresses
      ...                                                                     
           
      d                 s           2000    varying inz                                              
           d defaultMaxSpools
      ...                                                                          
           
      d                 s             10i 0 inz(1000)                                                
           
      d defaultStartTime...                                                                          
           
      d                 s               t   inz(t'06.30.00')                                         
           
      d defaultEndTime...                                                                            
           
      d                 s               t   inz(t'16.00.00')                                         
           
      d delayMinutes    s              3  0 inz(60)                                                  
           
      d EndOfDay        s               t   inz(t'17.30.00')                                         
           
      d EndOfDayOvertime...                                                                          
           
      d                 s               t   inz(t'00.30.00')                                         
           
      d EntryFmt        s             10    inz('*FIRST')                                            
           
      d ErrorCode       s              7    inz                                                      
           d ErrorReturned   s               n   inz                                                      
           d Error           s              4  0 inz                                                      
           d FTLIn1S         s             10i 0 inz                                                      
           d Format          s              8    inz
      ('SBSI0200')                                          
           
      d foundme         s             10i 0 inz                                                      
           d foundmessage    s             10i 0 inz                                                      
           d foundOutQ       s             10i 0 inz                                                      
           d foundOutQueue   s             10i 0 inz                                                      
           d FoundInSyspoolp
      ...                                                                           
           
      d                 s             10i 0 inz                                                      
           d FoundSpool      s               n   inz
      ('1')                                                 
           
      d i               s             10i 0 inz                                                      
           d IgnoreJobs      s             10    dim
      (2000)                                                
           
      d IJ#             s             10i 0 inz                                                      
           
      d InMonthEnd      s               n   inz                                                      
           d InYearEnd       s               n   inz                                                      
           d IResetTheWebserverStamp
      ...                                                                   
           
      d                 s               z   inz                                                      
           d IsodateIn       s              8    inz                                                      
           d IsoFromDate     s               d   inz                                                      
           d IsoToDate       s               d   inz                                                      
           d IsThereAnError  s               n   inz                                                      
           d JC
      #             s             10i 0 inz                                                      
           
      d jobended        s            132    inz                                                      
           d JobendedInError
      ...                                                                           
           
      d                 s               n   inz                                                      
           d jobqlibrary     s             20a   inz                                                      
           d jobqName        s             20a   inz
      ('QGPL/QINTER')                                       
           
      d jobstarted      s            132    inz                                                      
           d KeepLooping     s               n   inz
      ('1')                                                 
           
      d LogMessages     s            512    varying inz('CPF1124 CPF1164')                           
           
      d LenRtnVals      s             10i 0 Inz(%SIZE(RtnValsDS))                                    
           
      d MaxItemLines    s             10i 0 Inz(32766)                                               
           
      d message         s           2000    varying                                                  
           d MD
      #             s             10i 0 inz                                                      
           
      d mm#             s              3  0 inz                                                      
           
      d MinutesToWaitB4Resend...                                                                     
           
      d                 s             10i 0 inz(5)                                                   
           
      d MMDDYY          s              6  0                                                          
           d MQ
      #             s             10i 0 inz                                                      
           
      d MS#             s             10i 0 inz                                                      
           
      d MyContacts      s            512    varying                                                  
           d MyFullMessage   s            256                                                             
           d MySpoolStatus   s             08    inz                                                      
           d MySQLDate       s             20    varying                                                  
           d MySQLJobname    s             20    varying                                                  
           d MyWorkJobQueue  s             20    inz                                                      
           d MyWorktime      s               t   inz                                                      
           d MyTableName     s             36    inz                                                      
           d NamValue        s             10a   Inz
      ('SYSNAME')                                           
           
      d NbrVals         s             10i 0 Inz(1)                                                   
           
      d NumberOfDays    s             10i 0 inz                                                      
           d NumberOfSeconds
      ...                                                                           
           
      d                 s             10i 0 inz                                                      
           d NumberofRDYSpools
      ...                                                                         
           
      d                 s             10i 0                                                          
           d objectlib       s             20a   inz                                                      
           d outmessage      s            200    inz                                                      
           d outsubject      s             80    inz                                                      
           d outqname        s             20a   inz                                                      
           d oq
      #             s             10i 0 inz                                                      
           
      d PR#             s             10i 0 inz                                                      
           
      d ReturnSystemName...                                                                          
           
      d                 s              8    inz                                                      
           d RowCount        s             10i 0 inz                                                      
           d ReceiveVr2      s            100                                                             
           d RelRecNbr       s              4  0                                                          
           d RelRecHi
      #       s              4  0                                                          
           
      d UserSpaceOut    s             20                                                             
           d SendMessageAfterHours
      ...                                                                     
           
      d                 s              1    inz('Y')                                                 
           
      d SB#             s             10i 0 inz                                                      
           
      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 sleepseconds    s             10i 0 inz(120)                                                 
           
      d sf              s             10I 0 inz(1)                                                   
           
      d size            s             10I 0 inz                                                      
           d SpoolNumber     s              6a   inz                                                      
           d start           s             10i 0 inz
      (1)                                                   
           
      d StartOfDay      s               t   inz(t'07.30.00')                                         
           
      d StringSize      s              4  0 inz(244)                                                 
           
      d subject         s             44    varying                                                  
           d systemname      s             08    inz                                                      
           d systemstring    s             25    inz varying                                              
           d TodayISO        s               d                                                            
           d totalMinutes    s             10i 0 inz                                                      
           d TRStsE          s             10i 0 inz                                                      
           d UsrSpcName      s             20    inz                                                      
           d UsrSpcName2     s             20    inz                                                      
           d Workemailaddresses
      ...                                                                        
           
      d                 s           2000    varying inz                                              
           d workemail       s            128    inz                                                      
           d workCell        s             10  0 inz                                                      
           d workCellprovider
      ...                                                                          
           
      d                 s             10    inz                                                      
           d WorkGUID        s             26    inz                                                      
           d WorkJobName     s             20    inz                                                      
           d WorkMaxSpools   s             10  0 inz                                                      
           d WorkOutQueue    s             10    inz                                                      
           d Worktype        s             10    inz                                                      
            
      *                                                                                             
            * ---- 
      external procedure calls                                                               
            
      *                                                                                             
           
      d $GetSubsystemStatus...                                                                       
           
      d                 pr                  extpgm('QWDRSBSD')                                       
           
      d   StringBack                 244    const                                                    
           
      d   StringBackSize...                                                                          
           
      d                                4  0 const                                                    
           
      d   APIFormat                   08    const                                                    
           
      d   APISubsystem                20    const                                                    
           
      d   APIError                     4  0 const                                                    
            *                                                                                             
            * 
      CrtUsrSpcCreate User Space for OS/400 API's                                               
            *                                                                                             
           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)                               
            *                                                                                             
            * --- Prototype for API Retrive User Space                                                    
            *                                                                                             
           d $QUSRTVUS       pr                  extpgm( '
      QUSRTVUS' )                                     
           d   QRtvUserSpace_...                                                                          
           d                               20                                                             
           d   QRtvStartingPosition_...                                                                   
           d                               10i 0                                                          
           d   QRtvLengthOfData_...                                                                       
           d                               10i 0                                                          
           d   QRtvReceiverVariable_...                                                                   
           d                            32048                                                             
           d   QRtvError_...                                                                              
           d                              256                                                             
            * --- Prototype for API Retrive List Job                                                      
            *                                                                                             
           d $QUSLJOB        pr                  extpgm( '
      QUSLJOB' )                                      
           d   QJobUserSpace_...                                                                          
           d                               20                                                             
           d   QJobFormatName_...                                                                         
           d                                8                                                             
           d   QJobJobName_...                                                                            
           d                               26                                                             
           d   QFldStatus_...                                                                             
           d                               10                                                             
           d   QFldError_...                                                                              
           d                              256                                                             
           d   QJobType_...                                                                               
           d                                1                                                             
           d   QNbrFldRtn_...                                                                             
           d                               10i 0                                                          
           d   QKeyFldRtn_...                                                                             
           d                               10i 0 dim( 100 )                                               
            *                                                                                             
            * --- Prototype for get jobqueue information                                                  
            *                                                                                             
           d $GetJobq        pr                  EXTPGM('
      QSPRJOBQ')                                       
           d  RECIEVER_                   144A                                                            
           d  RCVRLEN_                     10I 0 const                                                    
           d  FORMAT_                       8A   const                                                    
           d  JOBQ_                        20A   consT                                                    
           d  ERROR_                      116A                                                            
           **-- List objects:   ---------------------------------------------                             
           d $ListObjects    pr                  ExtPgm( '
      QUSLOBJ' )                                      
           d  userspace_                   20a   Const                                                    
           d  format_                       8a   Const                                                    
           d  objectlib_                   20a   Const                                                    
           d  type_                        10a   Const                                                    
            *                                                                                             
           d $qcmdexc        pr                  extpgm( '
      QCMDEXC' )                                      
           d   os400_cmd_                5000A   options( *varsize ) const                                
           d   cmdlength_                  15P 5                     const                                
           **-- Userspace pointer: ------------------------------------------                             
           d $Userspace      pr                  ExtPgm( '
      QUSRTVUS' )                                     
           d  userspace_                   20a   Const                                                    
           d  start_                       10i 0 Const                                                    
           d  Length_                      10i 0 Const                                                    
           d  Returned_                 32767a         Options( *VarSize )                                
            *                                                                                             
           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 $QUSDLTUS       pr                  extpgm('
      QUSDLTUS')                                       
           d   UsrSpc_                     20A   const                                                    
           d   ErrorCode_               32766A   options(*varsize)                                        
            *                                                                                             
           d $QUSPTRUS       pr                  extpgm('
      QUSPTRUS')                                       
           d   UsrSpc_                     20A   const                                                    
           d   Pointer_                      *                                                            

            * Delay - sleep function                                                                      
           d $sleep          pr            10i 0 ExtProc( '
      sleep' )                                       
           d  seconds_                     10u 0 Value                                                    

           **-- Retrieve object description:  -------------------------------                             
           d $RtvObjD        Pr                  ExtPgm( '
      QUSROBJD' )                                     
           d  RoRcvVar                  32767a         Options( *VarSize )                                
           d  RoRcvVarLen                  10i 0 Const                                                    
           d  RoFmtNam                      8a   Const                                                    
           d  RoObjNamQ                    20a   Const                                                    
           d  RoObjTyp                     10a   Const                                                    
           d  RoError                   32767a         Options( *VarSize )                                

           **-- Create Space:   ---------------------------------------------                             
           d $CreateSpace    Pr                  ExtPgm( '
      QUSCRTUS' )                                     
           d  UserSpaceOut                 20a   Const                                                    
           d  SpaceAttr                    10    Const                                                    
           d  SpaceLen                     10i 0 Const                                                    
           d  SpaceVal                      1a   Const                                                    
           d  SpaceAuth                    10a   Const                                                    
           d  SpaceText                    50a   Const                                                    
           d  SpaceRepl                    10a   Const                                                    
           d  APIErrorDs                32767a         Options( *VarSize )                                

           d $getSystemName...                                                                            
           d                 PR                  ExtPgm('
      QWCRNETA')                                       
           d RcvVar_                    32766A   OPTIONS(*VARSIZE)                                        
           d RcvVarLen_                    10i 0 const                                                    
           d NbrNetAtr_                    10i 0 const                                                    
           d AttrNames_                    10a   const                                                    
           d ErrorCode_                   256a                                                            


            /copy qprcsrc,COMMAND_CP                                                                      
            /copy qprcsrc,GETGUID_CP                                                                      
            /copy qprcsrc,ROUTER_CP                                                                       
            /copy qprcsrc,SDEMAIL_CP                                                                      
            /copy qprcsrc,SPL2PDF_CP                                                                      
            /copy qprcsrc,USRDATA_CP                                                                      
            *                                                                                             
            * --- Data Structures                                                                         
            *                                                                                             
           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 RtnValsDS       ds                                                                           
           d  RtnNbrVals                   10i 0                                                          
           d  RtnOffVals                   10i 0                                                          
           d  RtnAtrNam                    10a                                                            
           d  RtnDtaTyp                     1a                                                            
           d  RtnInfSts                     1a                                                            
           d  RtnAtrLen                    10i 0                                                          
           d  RtnSystem                     8a                                                            
            *                                                                                             
           d ErrRtn          ds                                                                           
           d  ErrBytPrv                    10i 0 Inz(%SIZE(ErrRtn))                                       
           d  ErrBytAvl                    10i 0 Inz(0)                                                   
           d  ErrMsgId                      7a                                                            
           d  ErrResved                     1a                                                            
           d  ErrMsgDta                   256a                                                            




            ******************************************************************                            
           dQUSA0100         ds                                                                           
           d QUsrSpcOffset...                                                                             
           d                               10i 0                                                          
           d QUSAreserved...                                                                              
           d                               10i 0                                                          
           d QUsrSpcEntries...                                                                            
           d                               10i 0                                                          
           d QUsrSpcEntrieSize...                                                                         
           d                               10i 0                                                          
           dLJOBINPUT        ds                           qualified                                       
           d  JobName...                                                                                  
           d                               10                                                             
           d  UserName...                                                                                 
           d                               10                                                             
           d  JobNumber...                                                                                
           d                                6                                                             
           d  Status...                                                                                   
           d                               10                                                             
           d  UserSpace...                                                                                
           d                               10                                                             
           d  UserSpaceLibrary...                                                                         
           d                               10                                                             
           d  Format...                                                                                   
           d                                8                                                             
           d  JobType...                                                                                  
           d                                1                                                             
           d  Reserved01...                                                                               
           d                                3                                                             
           d  Reserved02...                                                                               
           d                               10i 0                                                          
            *                                                                                             
           dLJOB100          ds                           qualified                                       
           d  JobName...                                                                                  
           d                         1     10                                                             
           d  UserName...                                                                                 
           d                        11     20                                                             
           d  JobNumber...                                                                                
           d                        21     26                                                             
           d  InternalJobId...                                                                            
           d                        27     42                                                             
           d  Status...                                                                                   
           d                        43     52                                                             
           d  JobType...                                                                                  
           d                        53     53                                                             
           d  JobSubType...                                                                               
           d                        54     54                                                             
           d  Reserved01...                                                                               
           d                        55     56                                                             
            *                                                                                             
           dLJOB200          ds                           qualified                                       
           d  JobName...                                                                                  
           d                               10                                                             
           d  UserName...                                                                                 
           d                               10                                                             
           d  JobNumber...                                                                                
           d                                6                                                             
           d  InternalJobId...                                                                            
           d                               16                                                             
           d  Status...                                                                                   
           d                               10                                                             
           d  JobType...                                                                                  
           d                                1                                                             
           d  JobSubType...                                                                               
           d                                1                                                             
           d  Reserved01...                                                                               
           d                                2                                                             
           d  JobInfoStatus...                                                                            
           d                                1                                                             
           d  Reserved02...                                                                               
           d                                3                                                             
           d  NumberOfFieldsReturned...                                                                   
           d                               10i 0                                                          
           d  ReturnedData...                                                                             
           d                             1000                                                             
            *                                                                                             
           dLJOB200KEY       ds                           qualified                                       
           d  KeyNumber01...                                                                              
           d                               10i 0                                                          
           d  NumberOfKeys...                                                                             
           d                               10i 0                                                          
            *                                                                                             
           dLJOBKEYINFO      ds                           qualified                                       
           d  LengthOfInformation...                                                                      
           d                               10i 0                                                          
           d  KeyField...                                                                                 
           d                               10i 0                                                          
           d  TypeOfData...                                                                               
           d                                1                                                             
           d  Reserved01...                                                                               
           d                                3                                                             
           d  LengthOfData...                                                                             
           d                               10i 0                                                          
           d  KeyData...                                                                                  
           d                             1000                                                             
            *                                                                                             
            *  APIErrDef     Standard API error handling structure.                  *                    
            *                                                                                             
           dQUSEC            ds                                                                           
           d  ErrorBytesProvided...                                                                       
           d                               10i 0                                                          
           d  ErrorBytesAvailble...                                                                       
           d                               10i 0                                                          
           d  ErrorExceptionId...                                                                         
           d                                7                                                             
           d  ErrorReserved...                                                                            
           d                                1                                                             
            *                                                                                             
           dAPIError         ds                                                                           
           d APIErrorProvied...                                                                           
           d                                     LIKE( ErrorBytesProvided )                               
           d                                     INZ( %LEN( APIError ) )                                  
           d APIErrorAvailble...                                                                          
           d                                     LIKE( ErrorBytesAvailble )                               
           d APIErrorMessageID...                                                                         
           d                                     LIKE( ErrorExceptionId )                                 
           d APIErrorReserved...                                                                          
           d                                     LIKE( ErrorReserved )                                    
           d APIErrorInformation...                                                                       
           d                              240A                                                            

           d APIErrorDS      ds                  Qualified                                                
           d  BytesP                       10I 0 inz(%size(apiErrorDS))                                   
           d  BytesA                       10I 0 inz(0)                                                   
           d  Messageid                     7                                                             
           d  Reserved                      1                                                             
           d  messagedta                  128                                                             

           dMyJobQDS         ds                  Qualified                                                
           d BytesReturned                 10i 0                                                          
           d BytesAvailable                10i 0                                                          
           d JobQName                      10                                                             
           d JobQLib                       10                                                             
           d OppControlled                 10                                                             
           d AuthorityChk                  10                                                             
           d NumberOfJobs                  10i 0                                                          
           d JobqStatus                    10                                                             
           d SubsystemName                 10                                                             
           d SubsystemLib                  10                                                             
           d Description                   50                                                             
           d Sequence#                     10i 0                                                          
           d MaximumActive                 10i 0                                                          
           d CurrentActive                 10i 0                                                          
           d MaxActPri1                    10i 0                                                          
           d MaxActPri2                    10i 0                                                          
           d MaxActPri3                    10i 0                                                          
           d MaxActPri4                    10i 0                                                          
           d MaxActPri5                    10i 0                                                          
           d MaxActPri6                    10i 0                                                          
           d MaxActPri7                    10i 0                                                          
           d MaxActPri8                    10i 0                                                          
           d MaxActPri9                    10i 0                                                          
           d ActJobsPri1                   10i 0                                                          
           d ActJobsPri2                   10i 0                                                          
           d ActJobsPri3                   10i 0                                                          
           d ActJobsPri4                   10i 0                                                          
           d ActJobsPri5                   10i 0                                                          
           d ActJobsPri6                   10i 0                                                          
           d ActJobsPri7                   10i 0                                                          
           d ActJobsPri8                   10i 0                                                          
           d ActJobsPri9                   10i 0                                                          
           d ActJobsPri10                  10i 0                                                          
           d RlsJObsOnQ1                   10i 0                                                          
           d RlsJObsOnQ2                   10i 0                                                          
           d RlsJObsOnQ3                   10i 0                                                          
           d RlsJObsOnQ4                   10i 0                                                          
           d RlsJObsOnQ5                   10i 0                                                          
           d RlsJObsOnQ6                   10i 0                                                          
           d RlsJObsOnQ7                   10i 0                                                          
           d RlsJObsOnQ8                   10i 0                                                          
           d RlsJObsOnQ9                   10i 0                                                          
           d RlsJObsOnQ10                  10i 0                                                          
           d SchJobsOnQ1                   10i 0                                                          
           d SchJobsOnQ2                   10i 0                                                          
           d SchJobsOnQ3                   10i 0                                                          
           d SchJobsOnQ4                   10i 0                                                          
           d SchJobsOnQ5                   10i 0                                                          
           d SchJobsOnQ6                   10i 0                                                          
           d SchJobsOnQ7                   10i 0                                                          
           d SchJobsOnQ8                   10i 0                                                          
           d SchJobsOnQ9                   10i 0                                                          
           d SchJobsOnQ10                  10i 0                                                          
           d HldJobsOnQ1                   10i 0                                                          
           d HldJobsOnQ2                   10i 0                                                          
           d HldJobsOnQ3                   10i 0                                                          
           d HldJobsOnQ4                   10i 0                                                          
           d HldJobsOnQ5                   10i 0                                                          
           d HldJobsOnQ6                   10i 0                                                          
           d HldJobsOnQ7                   10i 0                                                          
           d HldJobsOnQ8                   10i 0                                                          
           d HldJobsOnQ9                   10i 0                                                          
           d HldJobsOnQ10                  10i 0                                                          
           d ListJOBQ        ds                  qualified                                                
           d  Object                       10                                                             
           d  Library                      10                                                             
           d  ObjectType                   10                                                             
           d  InfoStatus                    1                                                             
           d  ExtObjAttrib                 10                                                             
           d  Description                  50                                                             
           d                 ds                                                                           
           d  StartPosit                   10i 0                                                          
           d  StartLen                     10i 0                                                          
           d  SpaceLen                     10i 0                                                          
           d  ReceiveLen                   10i 0                                                          
           d  MessageKey                   10i 0                                                          
           d  MsgDtaLen                    10i 0                                                          
           d  MsgQueNbr                    10i 0                                                          
            *                                                                                             
           d GENDS           ds                                                                           
           d  OffsetHdr                    10i 0  overlay(GENDS:1)                                        
           d  NbrInList                    10i 0  overlay(GENDS:9)                                        
           d  SizeEntry                    10i 0  overlay(GENDS:13)                                       
      ?     *                                                                                             
      ?     *  Data structures                                                                            
           d GENDS2          ds                  qualified                                                
           d  Filler1                     116                                                             
           d  OffsetHdr                    10i 0                                                          
           d  SizeHeader                   10i 0                                                          
           d  OffsetList                   10i 0                                                          
           d  Filler2                       4                                                             
           d  NbrInList                    10i 0                                                          
           d  SizeEntry                    10i 0                                                          
            *                                                                                             
           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                                                            
            // used to store max spool number override                                                    
           d MyMaxSpool      ds                  qualified  inz                                           
           d   WholeString                 20    dim(1000) overlay(MyMaxSpool:*next)                      
           d    OutQname                   10    overlay(WholeString:1)                                   
           d    Maximum                    10i 0 overlay(WholeString:*next)                               
            // used to ignore JOBQs                                                                       
           d SkipJobQs       ds                  qualified  inz                                           
           d   WholeString                 20    dim(100) overlay(SkipJobQs:*next)                        
           d    JobQueue                   20    overlay(WholeString:1)                                   
            // used to sort the contacts                                                                  
           d Contacts        ds                  qualified  inz                                           
           d   WholeString                522    dim(100) overlay(Contacts:*next)                         
           d    Name                      512    overlay(WholeString:1)                                   
           d    Sequence                   10  0 overlay(WholeString:*next)                               
            *                                                                                             
            // jobs to check if running                                                                   
           d SentMessages    ds                  dim(1000) qualified  inz                                 
           d    Message                   256    overlay(SentMessages:1)                                  
           d    messagetime                  Z   overlay(SentMessages:*next)                              
            *                                                                                             
            // subsystem to make sure they are running                                                    
           d Subsystems      ds                  dim(1000) qualified  inz                                 
           d    Name                       20    overlay(Subsystems:1)                                    
            *                                                                                             
            // userprofiles to ingnore when looking @ *DISABLED profiles                                  
           d Profiles        ds                  dim(1000) qualified  inz                                 
           d    Name                       20    overlay(Profiles:1)                                      
            *                                                                                             
           d SubsystemDS     ds            20    qualified  inz                                           
           d    Subsystem                  10    overlay(SubsystemDS:1)                                   
           d    Library                    10    overlay(SubsystemDS:*next)                               
           d ReturnStringDS  ds           244    inz qualified                                            
           d    Status                     07    overlay(ReturnStringDS:53)                               
            *                                                                                             
            *  check data on unatcached jobs                                                              
            *                                                                                             
           d c1              ds                  Dim(32766) Qualified Inz                                 
           d  program                      10                                                             
           d  description                  30                                                             
           d  code                          1                                                             
            *                                                                                             
            * 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 ListProfilesDS  ds                  qualified                                                
           d  Object                       10                                                             
           d  Library                      10                                                             
           d  ObjectType                   10                                                             
           d  InfoStatus                    1                                                             
           d  ExtObjAttrib                 10                                                             
           d  Description                  50                                                             
           **-- Object description structure OBJD0400:  ----------------------------**                    
           d ObjectDs        ds                  qualified  inz                                           
           d  ObjDscLen                    10i 0                                                          
           d  ObjDscSiz                    10i 0                                                          
           d  ObjNam                       10                                                             
           d  ObjLib                       10                                                             
           d  ObjTyp                       10                                                             
           d  ObjRtnLib                    10                                                             
           d  ObjAsp                       10i 0                                                          
           d  ObjOwnr                      10                                                             
           d  ObjDmn                        2                                                             
           d  ObjCrtDat                    13                                                             
           d  ObjChgDat                    13                                                             
            *                                                                                             
           d  ObjAtr                       10                                                             
           d  ObjTxt                       50                                                             
           d  ObjSrcFil                    10                                                             
           d  ObjSrcLib                    10                                                             
           d  ObjSrcMbr                    10                                                             
            *                                                                                             
           d  ObjSrcChgDat                 13                                                             
           d  ObjSrcSavDat                 13                                                             
           d  ObjSrcRstDat                 13                                                             
           d  ObjCrtUsr                    10                                                             
           d  ObjCrtSys                     8                                                             
           d  ObjResDat                     7                                                             
           d  ObjSavSiz                    10i 0                                                          
           d  ObjSavSeq                    10i 0                                                          
           d  ObjStg                       10                                                             
           d  ObjSavCmd                    10                                                             
           d  ObjSavVolId                  71                                                             
           d  ObjSavDvc                    10                                                             
           d  ObjSavFil                    10                                                             
           d  ObjSavLib                    10                                                             
           d  ObjSavLvl                     9                                                             
           d  ObjCompiler                  16                                                             
           d  ObjLvl                        8                                                             
           d  ObjUsrChg                     1                                                             
           d  ObjLicPgm                    16                                                             
           d  ObjPtf                       10                                                             
           d  ObjApar                      10                                                             
            *  start of four                                                                              
           d  ObjUseDat                     7                                                             
           d  ObjUsgInf                     1                                                             
           d  ObjUseDay                    10i 0                                                          
           d  ObjSiz                       10i 0                                                          
           d  ObjSizMlt                    10i 0                                                          
           d  ObjCprSts                     1                                                             
           d  ObjAlwChg                     1                                                             
           d  ObjChgByPgm                   1                                                             
           d  ObjUsrAtr                    10                                                             
           d  ObjOvrflwAsp                  1                                                             
           d  ObjSavActDat                  7                                                             
           d  ObjSavActTim                  6                                                             
           d  ObjAudVal                    10                                                             
           d  ObjPrmGrp                    10                                                             
            *-----------------------------------------------------------------                            
            * program status dataarea                                                                     
            *-----------------------------------------------------------------                            
           d PgmSts         SDS                                                                           
           d   P1User              254    263                                                             
           d   @PGM            *PROC                                                                      
           d  @JOB                 244    253                                                             
            *--------------------------------------------------------------*                              
            * work fields                                                  *                              
            *--------------------------------------------------------------*                              
           d Variables       ds                                                                           
           d   Q                            1    inz( '''' )                                              
           d   Count                       15  0 inz(  0   )                                              
           d   KeyCount                    15  0 inz(  0   )                                              
           d   EndPos                      15  0 inz(  0   )                                              
           d   JobbStatus                   4    inz( ' '  )                                              
           d   Subsystem                   20    inz( ' '  )                                              
           d   ReturnCode                   1    inz( ' '  )                                              
           d   FormatName                   8    inz( ' ' )                                               
           d   QualifedJobName...                                                                         
           d                               26    inz( ' ' )                                               
           d   JobStatus                   10    inz( ' ' )                                               
           d   JobType                      1    inz( ' ' )                                               
           d   NbrOfFldRtn                 10i 0 inz(  0  )                                               
           d   KeyFldRtn                   10i 0 inz(  0  ) dim( 100 )                                    
           d   StartingPosition...                                                                        
           d                               10i 0 inz(  0  )                                               
           d   LengthOfData...                                                                            
           d                               10i 0 inz(  0  )                                               
           d   KeyStartingPosition...                                                                     
           d                               10i 0 inz(  0  )                                               
           d   KeyLengthOfData...                                                                         
           d                               10i 0 inz(  0  )                                               
           d   ReceiverVariable...                                                                        
           d                            32048                                                             
           d   OS400_Cmd                 5000    inz( ' '  )                                              
           d   CmdLength                   15P 5 inz( %size( OS400_Cmd ) )                                
           d   True                         1    inz( *on  )                                              
           d   False                        1    inz( *off )                                              
            *                                                                                             
            /free                                                                                         
                 Exec Sql Set Option --Naming    = *Sys,                                                  
                                       Commit    = *None,                                                 
                                       SRTSEQ    = *LANGIDUNQ;                                            

             // get system name                                                                           
             $getsystemName(RtnValsDS:                                                                    
                            LenRtnVals:                                                                   
                            NbrVals:                                                                      
                            NamValue:                                                                     
                            ErrRtn);                                                                      
             ReturnSystemName = RtnSystem;                                                                



             // nothing ever turns keeplooping off, so it loops till someone ends it                      
             reset keeplooping;                                                                           
             dow  keeplooping;                                                                            
              // load defaults in the loop -- changes to sycontrol                                        
              exsr $LoadDefaults;                                                                         
              // reach out and get the system logs                                                        
              //exsr $GetSystemLogs;                                                                      
              //                                                                                          
              // Create a user space                                                                      
              //                                                                                          
              size = 10000;                                                                               
              // Create a user space                                                                      
              UsrSpcName  = '
      DSPJOB    QTEMP     ';                                                       
              $QUSCRTUS(UsrSpcName: '
      USRSPC': size: x'00': '*ALL':                                        
               '
      Temp User Space for  QUSLJOB API':  '*YES': APIError);                                    
              // look thru wrkactjob for errors                                                           
              exsr $CheckStatusOfJob;                                                                     
              // delete user space                                                                        
              $QUSDLTUS(UsrSpcName: dsEC);                                                                

              // check JobQueues for jobs in error                                                        
              exsr $CheckJobQueues;                                                                       
              // delete user space                                                                        
              $QUSDLTUS(UsrSpcName: dsEC);                                                                

              // check list of sbsystems active                                                           
              exsr $CheckSubsystems;                                                                      

              // look thru unattached jobs to find errors                                                 
              exsr $CheckUnattachedJobs;                                                                  

              // look for *Disable Profiles                                                               
              exsr $CheckUserProfiles;                                                                    


              // check outqueues                                                                          
              exsr $CheckOutQueues;                                                                       

              // sleep for variable time (delay job)                                                      
              $sleep(sleepseconds);                                                                       
             enddo;                                                                                       
             *inlr = *on;                                                                                 
             // *************************************************************                             
             // load the defaults from sycontrol                                                          
             begsr $loadDefaults;                                                                         
              if not %open(sycontrol);                                                                    
               open sycontrol;                                                                            
              endif;                                                                                      
              // get jobQ'
      s to Skip                                                                       
              clear SkipJobQs
      ;                                                                            
              
      reset MQ#;                                                                                  
              
      setll (@PGM:'IGNOREJOBQ' sycontrol;                                                       
              
      dou %eof(sycontrol);                                                                        
               
      reade (@PGM:'IGNOREJOBQ'sycontrol;                                                       
               if 
      not%eof(sycontrol);                                                                     
                
      // load array with the ignore JOB queues                                                  
                
      MQ#+=1;                                                                                   
                
      SkipJobQs.JobQueue(MQ#) = %trim(SYVALUEC);                                                
               
      endif;                                                                                     
              
      enddo;                                                                                      
              
      // get max spools by outqueue                                                               
              
      clear IgnoreJobs;                                                                           
              
      reset MS#;                                                                                  
              
      setll (@PGM'OVRMAXSPL'sycontrol;                                                        
              
      dou %eof(sycontrol);                                                                        
               
      reade (@PGM'OVRMAXSPL'sycontrol;                                                       
               if 
      not%eof(sycontrol);                                                                     
                
      // load array with the ignore jobs                                                        
                
      MS#+=1;                                                                                   
                
      MyMaxSpool.OutQname(MS#) = %trim(SYVALUEC);                                               
                
      monitor;                                                                                  
                 
      MyMaxSpool.Maximum(MS#) = SYVALUED;                                                      
                
      on-error;                                                                                 
                 
      MyMaxSpool.Maximum(MS#) = defaultMaxSpools;                                              
                
      endmon;                                                                                   
               endif;                                                                                     
              
      enddo;                                                                                      
              
      chain (@PGM'WORKHOURS'sycontrol;                                                        
              if %
      found(sycontrol);                                                                       
               
      defaultStartTime = %time(SYTIME1:*hms);                                                    
               
      defaultEndTime = %time(SYTIME2:*hms);                                                      
              endif;                                                                                      
              
      chain (@PGM'MSGRESEND'sycontrol;                                                        
              if %
      found(sycontrol);                                                                       
               
      DelayMinutes SYVALUED;                                                                   
              endif;                                                                                      

              
      // load the subsystems to verify they are running                                           
              
      clear subsystems;                                                                           
              
      reset sb#;                                                                                  
              
      setll (@PGM'SUBSYSTEM'sycontrol;                                                        
              
      dou  %eof(sycontrol);                                                                       
               
      reade (@PGM'SUBSYSTEM'sycontrol;                                                       
               if 
      not %eof(sycontrol);                                                                    
                
      sb#+=1;                                                                                   
                
      subsystems(sb#).name = %trim(%subst(SYVALUEC:1:20));                                      
               
      endif;                                                                                     
              
      enddo;                                                                                      

              
      // load user profiles to ignore when looking for *DISABLED                                  
              
      clear profiles;                                                                             
              
      reset pr#;                                                                                  
              
      setll (@PGM'PROFILE'sycontrol;                                                          
              
      dou  %eof(sycontrol);                                                                       
               
      reade (@PGM'PROFILE'sycontrol;                                                         
               if 
      not %eof(sycontrol);                                                                    
                
      pr#+=1;                                                                                   
                
      profiles(pr#).name = %trim(%subst(SYVALUEC:1:20));                                        
               
      endif;                                                                                     
              
      enddo;                                                                                      


              if %
      open(sycontrol);                                                                        
               
      close sycontrol;                                                                           
              endif;                                                                                      
             
      endsr;                                                                                       
             
      // *************************************************************                             
             // check status of an job                                                                    
             
      begsr $CheckStatusOfJob;                                                                     
             
      reset  AEJOBisRunning;                                                                       
             
      reset  AEJOBisOnHold;                                                                        
             
      // run API to fill user space with information about all iSeries job                         
             
      FormatName 'JOBL0200';                                                                     
             
      QualifedJobName '*ALL      ' '*ALL      ' '*ALL  ';                                    
             
      JobStatus '*ACTIVE';                                                                       
             
      JobType '*';                                                                               
             
      NbrOfFldRtn 2;                                                                             
             
      KeyFldRtn) = 0101;                                                                       
             
      KeyFldRtn) = 1906;                                                                       
             
      $QUSLJOBUsrSpcName FormatName  QualifedJobName :                                       
                       
      JobStatus  APIError    :                                                         
                       
      JobType    NbrOfFldRtn KeyFldRtn         );                                    
              
      // if error message from the retrieve job API then dump program                             
             
      if APIErrorMessageID <> ' ';                                                                 
               
      dump;                                                                                      
               
      ReturnCode True;                                                                         
               
      leavesr;                                                                                   
             endif;                                                                                       
             
      // run API to get user space attribute                                                       
             
      StartingPosition 125;                                                                      
             
      LengthOfData 16;                                                                           
             
      $QUSRTVUSUsrSpcName   StartingPosition  :                                                
                        
      LengthOfData ReceiverVariable  :                                                
                        
      APIError                           );                                             
             
      QUSA0100 ReceiverVariable;                                                                 
              
      // if error message from the retrieve user space API then dump program                      
             
      if APIErrorMessageID <> ' ';                                                                 
               
      dump;                                                                                      
               
      ReturnCode True;                                                                         
               
      leavesr;                                                                                   
             endif;                                                                                       
             
      // preperation to read from user space                                                       
             
      StartingPosition QUsrSpcOffset 1;                                                        
             
      LengthOfData QUsrSpcEntrieSize;                                                            
             
      // read from user space                                                                      
             
      for count 1 to QUsrSpcEntries;                                                             
               
      $QUSRTVUSUsrSpcName   StartingPosition  :                                              
                          
      LengthOfData ReceiverVariable  :                                              
                          
      APIError                           );                                           
               
      LJOB200 ReceiverVariable;                                                                
               if 
      APIErrorMessageID <> ' ';                                                               
                 
      dump;                                                                                    
                 
      ReturnCode True;                                                                       
                 
      leavesr;                                                                                 
               endif;                                                                                     
               
      // check status of job                                                                     
               
      JobbStatus ' ';                                                                          
               
      Subsystem ' ';                                                                           
               
      LJobKeyInfo LJob200.ReturnedData;                                                        
               
      // Job type                                                                                
               // A  The job is an autostart job.                                                         
               // B  The job is a batch job.                                                              
               // I  The job is an interactive job.                                                       
               // M  The job is a subsystem monitor job.                                                  
               // R  The job is a spooled reader job.                                                     
               // S  The job is a system job.                                                             
               // W  The job is a spooled writer job.                                                     
               // X  The job is the SCPF system job.                                                      
               // Job subtype                                                                             
               // D  The job is a batch immediate job.                                                    
               // E  The job started with a procedure start request.                                      
               // F  The job is an AS/400 Advanced 36 machine server job.                                 
               // J  The job is a prestart job.                                                           
               // P  The job is a print driver job.                                                       
               // T  The job is a System/36 multiple requester terminal (MRT) job.                        
               // U  The job is an alternate spool user.                                                  
               
      KeyStartingPosition 1;                                                                   
               
      KeyLengthOfData LJobKeyInfo.LengthOfInformation;                                         
               for 
      keycount 1 to LJob200.NumberOfFieldsReturned;                                        
                 
      LJobKeyInfo = %substLJob200.ReturnedData :                                             
                                       
      KeyStartingPosition :                                              
                                       
      KeyLengthOfData );                                                 
                 
      KeyLengthOfData LJobKeyInfo.LengthOfInformation;                                       
                 
      LJobKeyInfo = %substLJob200.ReturnedData :                                             
                                       
      KeyStartingPosition :                                              
                                       
      KeyLengthOfData );                                                 
                 
      Endpos LJobKeyInfo.LengthOfData;                                                       
                 if     
      LJobKeyInfo.KeyField 0101;                                                      
                    
      JobbStatus = %substLJobKeyInfo.KeyData :  Endpos );                             
                 elseif 
      LJobKeyInfo.KeyField 1906;                                                      
                    
      Subsystem = %substLJobKeyInfo.KeyData Endpos );                               
                 endif;                                                                                   
                 
      KeyStartingPosition KeyStartingPosition KeyLengthOfData;                             
               endfor;                                                                                    
               if 
      ljob200.jobname 'AEJOB' and                                                           
                  
      LJOB200.JOBTYPE 'A';                                                                  
                
      AEJOBisRunning = *on;                                                                     
                if 
      Jobbstatus 'HLD';                                                                    
                 
      AEJOBisOnHold = *on;                                                                     
                ENDIF;                                                                                    
               endif;                                                                                     
               
      // if job in message wait then email message to address in                                 
               // variable email address  -- Skip printer jobs                                            
               
      if Jobbstatus 'MSGW' and                                                                 
                  
      LJOB200.JOBTYPE <> 'W' and                                                              
                  
      LJOB200.JOBTYPE <> 'R' and                                                              
                  %
      lookup(ljob200.jobname:IgnoreJobs) = 0;                                                
                 
      outsubject 'Job ' + %trim(ljob200.jobname) + ' is in *MSGW';                           
                 
      outmessage 'Job in Message wait:  ' +                                                  
                               %
      trim(ljob200.jobname) + '  ' +                                            
                               %
      trim(ljob200.username) + '  ' +                                           
                               %
      trim(ljob200.jobnumber);                                                  
                 
      workjobname = %trim(ljob200.jobname) + %trim(ljob200.username);                          
                 
      exsr $sendusermessage;                                                                   
               endif;                                                                                     
               
      StartingPosition StartingPosition LengthOfData;                                        
             endfor;                                                                                      
              
      // get the system name                                                                      
              
      exec sql                                                                                    
               values current server                                                                      
               into 
      :SystemName;                                                                          
             if 
      AEJOBisRunning = *off and SystemName 'S215B43V';                                        
                 
      outsubject 'AEJOB not running';                                                        
                 
      outmessage 'Job AEJOB not running in Subsystem AESBS';                                 
                 
      exsr $sendusermessage;                                                                   
             endif;                                                                                       
             if 
      AEJOBisOnHold = *on and SystemName 'S215B43V';                                          
              
      outsubject 'AEJOB is HELD';                                                               
              
      outmessage 'Job AEJOB HELD in Subsystem AESBS';                                           
              
      exsr $sendusermessage;                                                                      
             endif;                                                                                       
             
      endsr;                                                                                       
             
      // *************************************************************                             
             // Look for jobqueues on HOLD                                                                
             
      begsr $CheckJobQueues;                                                                       
              
      worktype '*JOBQ';                                                                         
              
      // Create a user space                                                                      
              
      UsrSpcName  'JOBQS     QTEMP     ';                                                       
              
      $QUSCRTUS(UsrSpcName'USRSPC'sizex'00''*ALL':                                        
              
      'Temp User Space for JOB queues':  '*YES'APIError);                                       
              
      ObjectLib =  '*ALL      ' '*ALL';                                                         
              
      //                                                                                          
              // List all the outqueues to the user space                                                 
              //                                                                                          
              
      $ListObjectsUsrSpcName'OBJL0200' ObjectLib WorkType);                               
              
      //                                                                                          
              // Retrive header entry and process the user space                                          
              //                                                                                          
              
      StartPosit 125;                                                                           
              
      StartLen   16;                                                                            
              
      $UserSpace(UsrSpcName StartPosit StartLen GENDS);                                     
              
      StartPosit OffsetHdr 1;                                                                 
              
      StartLen = %size(ListJOBQ);                                                                 
              for 
      count 1 to  NbrInList;                                                                
               
      $UserSpaceUsrSpcName StartPosit StartLen ListJOBQ);                                
               
      StartPosit += SizeEntry;                                                                   
               
      // skip the JOBQ's we are told to skip                                                     
               
      If %lookup(ListJOBQ.Object:SkipJobQs.jobqueue) > *zeros;                                   
                
      iter;                                                                                     
               endif;                                                                                     
               
      jobqlibrary ListJOBQ.Object + %trim(ListJOBQ.Library);                                   
                
      $GetJobQ(MyJobQDS  :%SIZE(MyJobQDS  ):'JOBQ0200':                                         
                 
      jobqlibrary:apierror);                                                                   
                if 
      MyJobQDS.JobqStatus 'HELD';                                                          
                 
      Outsubject 'JobQ ' + %trim(MyJobQDS.JobQName) +                                        
                              
      ' is HELD ';                                                                
                 
      Outmessage 'Please logon to system and check status of this JobQ';                     
                 
      workjobname = %trim(jobqlibrary);                                                        
                 
      exsr $sendusermessage;                                                                   
                endif;                                                                                    
              endfor;                                                                                     
             
      endsr;                                                                                       
             
      // *************************************************************                             
             // *************************************************************                             
             // Check the outqueues                                                                       
             
      begsr $CheckOutQueues;                                                                       
              
      worktype '*OUTQ';                                                                         
              
      // Create a user space                                                                      
              
      UsrSpcName  'OUTQS     QTEMP     ';                                                       
              
      $QUSCRTUS(UsrSpcName'USRSPC'sizex'00''*ALL':                                        
              
      'Temp User Space for JOB queues':  '*YES'APIError);                                       
              
      ObjectLib =  '*ALL      ' '*ALL';                                                         
              
      //                                                                                          
              // List all the outqueues to the user space                                                 
              //                                                                                          
              
      $ListObjectsUsrSpcName'OBJL0200' ObjectLib WorkType);                               
              
      //                                                                                          
              // Retrive header entry and process the user space                                          
              //                                                                                          
              
      StartPosit 125;                                                                           
              
      StartLen   16;                                                                            
              
      $UserSpace(UsrSpcName StartPosit StartLen GENDS);                                     
              
      StartPosit OffsetHdr 1;                                                                 
              
      StartLen = %size(ListJOBQ);                                                                 
              for 
      count 1 to  NbrInList;                                                                
               
      $UserSpaceUsrSpcName StartPosit StartLen ListJOBQ);                                
               
      StartPosit += SizeEntry;                                                                   
               
      OutQname ListJOBQ.Object + %trim(ListJOBQ.Library);                                      
               
      exsr $GetSPLFList;                                                                         
              endfor;                                                                                     
             
      endsr;                                                                                       

              
      //===========================================                                               
              // $GetSPLFList - Get Spooled File List                                                     
              //===========================================                                               

                   
      begsr $GetSPLFList;                                                                    
                     
      // set this to zero to let OS/400 handle errors                                      
                    
      dsEC.BytesProvided 0;                                                               
                    
      // make space for (approx) 10000 spooled files to be listed                           
                    
      size = %size(dsLH) + 512 + (%size(dsSF) * 10000);                                     
                   
      // create a user space                                                                 
                   // List spooled files to the user space                                                
                   // Get a pointer to the returned user space                                            
                   
      UsrSpcName2 'SPOOLS    QTEMP     ';                                                  
                   
      // Create a user space                                                                 
                   
      $QUSCRTUS(UsrSpcName2'USRSPC'sizex'00''*ALL':                                  
                   
      'Temp User Space for QUSLSPL API':  '*YES'dsEC);                                     

                   
      // List spooled files to the user space                                                
                   
      monitor;                                                                               
                   
      $QUSLSPL(UsrSpcName2'SPLF0300''*ALL'OutQName:                                    
                   
      '*ALL''*ALL'dsEC);                                                                 
                   
      on-error;                                                                              
                    
      // delete user space                                                                  
                    
      monitor;                                                                              
                     
      $QUSDLTUS(UsrSpcName2dsEC);                                                        
                    
      on-error;                                                                             
                    
      endmon;                                                                               
                    
      leavesr;                                                                              
                   
      endmon;                                                                                

                   
      // Get a pointer to the returned user space                                            
                   
      $QUSPTRUS(UsrSpcName2p_UsrSpc);                                                      
                  
      // 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                                        
                    
      p_Entry p_UsrSpc dsLH.ListOffset;                                                 
                    
      sf 1;                                                                               
                    
      reset NumberofRDYSpools;                                                              
                    
      dow  sf <= dsLH.NumEntries;                                                           
                     
      // currently only count status = 1 ready                                             
                     
      if  dsSF.SplfStatus 1;                                                             
                      
      NumberOfRDYSpools+=1;                                                               
                     else;                                                                                
                      if  
      dsSF.SplfStatus 7;                                                            
                       
      Outsubject 'Spooled File in *MSGW  ';                                            
                       
      Outmessage 'Please check outQ:  ' +                                              
                                     %
      trim(ListJOBQ.Library) + '/' +                                      
                                     %
      trim(ListJOBQ.Object);                                              
                       
      workjobname = %trim(ListJOBQ.Object) + %trim(ListJOBQ.Library);                    
                       
      exsr $sendusermessage;                                                             
                      endif;                                                                              
                     endif;                                                                               

                    
      // see if there is an overrode defaultmax spool for this                              
                    // outQueue if so replace                                                             
                    
      foundme = %lookup(ListJOBQ.Object:MyMaxSpool.OutQname);                               
                    if 
      foundme 0;                                                                       
                     
      workMaxSpools MyMaxSpool.Maximum(foundme);                                         
                    else;                                                                                 
                     
      WorkMaxSpools defaultMaxSpools;                                                    
                    endif;                                                                                
                    
      // maximum number of spooled file check                                               
                    
      if NumberOfRDYSpools >= WorkMaxSpools;                                                
                     
      Outsubject 'Maximum Spooled files in OUTQ ';                                       
                     
      Outmessage 'Please check outQ:  ' +                                                
                                   %
      trim(ListJOBQ.Library) + '/' +                                        
                                   %
      trim(ListJOBQ.Object);                                                
                     
      workjobname = %trim(ListJOBQ.Object) + %trim(ListJOBQ.Library);                      
                     
      exsr $sendusermessage;                                                               
                    endif;                                                                                

                    
      p_Entry  +=  dsLH.EntrySize;                                                          
                    
      sf +=1;                                                                               
                   
      enddo;                                                                                 

                    
      // delete user space                                                                  
                    
      $QUSDLTUS(UsrSpcName2dsEC);                                                         


                   
      endsr;                                                                                 
              
      //===========================================                                               
              // make sure list of subystems are active                                                   
                   
      begsr $CheckSubsystems;                                                                
                    for 
      count 1 to sb#;                                                                 
                     
      subsystemDS subsystems(count).name;                                                
                     
      clear ReturnStringDS;                                                                
                     
      format 'SBSI0200';                                                                 
                     
      $GetSubsystemStatus(ReturnStringDS:StringSize:                                       
                                         
      Format:SubsystemDS:error);                                       
                     if 
      ReturnStringDS.status <> '*ACTIVE';                                               
                      
      Outsubject 'Subsystem ' + %trim(%subst(subsystemDS:1:10)) +                       
                                   
      ' is Not Active ';                                                     
                      
      Outmessage 'Please start subsystem';                                              
                      
      exsr $sendusermessage;                                                              
                     endif;                                                                               
                    endfor;                                                                               
                   
      endsr;                                                                                 
             
      // *************************************************************                             
             // $GetSystemLogs - get the system log information                                           
             
      begsr $GetSystemLogs;                                                                        
                   
      Exec Sql                                                                               
                    
      declare global temporary table MyWorkFile                                             
                    
      (mystring char(132))                                                                  
                    
      with replace;                                                                         
                   
      // OVRPRTF FILE(QPDSPLOG) HOLD(*YES) OVRSCOPE(*JOB)                                    
                   
      OneThousandLong 'OVRPRTF FILE(QPDSPLOG) HOLD(*YES) ' +                               
                                     
      '  OVRSCOPE(*JOB) MAXRCDS(*NOMAX)';                                  
                   
      monitor;                                                                               
                    
      runcommand(OneThousandLong);                                                          
                   
      on-error;                                                                              
                   
      endmon;                                                                                
                   
      // DSPLOG PERIOD((000001 070914) (*AVAIL *CURRENT)) OUTPUT(*PRINT) MSGID(CPF1124       
                   // CPF1164)                                                                            
                   
      MMDDYY = %dec(%date():*mdy);                                                           
                   
      OneThousandLong 'DSPLOG PERIOD((000001 ' +                                           
                     %
      trim(%editc(MMDDYY:'X')) + ') (*AVAIL *CURRENT))' +                                 
                     
      ' OUTPUT(*PRINT) MSGID(' + %trim(LogMessages) + ')';                                 
                   
      monitor;                                                                               
                    
      runcommand(OneThousandLong);                                                          
                   
      on-error;                                                                              
                   
      endmon;                                                                                
             
      //  CPYSPLF FILE(QPDSPLOG) TOFILE(QTEMP/MYWORKFILE) SPLNBR(*LAST)                            
                   
      OneThousandLong 'CPYSPLF FILE(QPDSPLOG) ' +                                          
                                     
      ' TOFILE(QTEMP/MYWORKFILE) ' +                                       
                                     
      '  SPLNBR(*LAST) ';                                                  
                   
      monitor;                                                                               
                    
      runcommand(OneThousandLong);                                                          
                   
      on-error;                                                                              
                   
      endmon;                                                                                
                   
      //  dltSPLF FILE(QPDSPLOG) SPLNBR(*LAST)                                               
                   
      OneThousandLong  'dltSPLF FILE(QPDSPLOG) SPLNBR(*LAST) ';                            
                   
      monitor;                                                                               
                    
      runcommand(OneThousandLong);                                                          
                   
      on-error;                                                                              
                   
      endmon;                                                                                
                   
      // DLTOVR FILE(QPDSPLOG) LVL(*JOB)                                                     
                   
      OneThousandLong 'DLTOVR FILE(QPDSPLOG) LVL(*JOB) ';                                  
                   
      monitor;                                                                               
                    
      runcommand(OneThousandLong);                                                          
                   
      on-error;                                                                              
                   
      endmon;                                                                                
             
      endsr;                                                                                       

              
      //===========================================                                               
              // $CheckUserProfiles   (*DISABLED)                                                         
              //===========================================                                               

                   
      begsr $CheckUserProfiles;                                                              

                    
      APIErrorDS.BytesP 116;                                                              
                    
      Spacename 'PROFILES';                                                               
                    
      SpaceLib 'QTEMP';                                                                   
                    
      //                                                                                    
                    // Create the user space                                                              
                    //                                                                                    
                    
      $CreateSpaceUserspace SpaceAttr 4096 :                                          
                                  
      SpaceVal SpaceAuth SpaceText SpaceRepl:                           
                                  
      APIErrorDs);                                                            
                    
      // find all files in the passed in Library                                            
                    
      ObjectLib =  '*ALL      ' '*ALL';                                                   
                    
      WorkType '*USRPRF';                                                                 
                    
      //                                                                                    
                    // List all the outqueues to the user space                                           
                    //                                                                                    
                    
      $ListObjectsUserspace 'OBJL0200' ObjectLib WorkType);                         
                    
      //                                                                                    
                    // Retrive header entry and process the user space                                    
                    //                                                                                    
                    
      StartPosit 125;                                                                     
                    
      StartLen   16;                                                                      
                    
      $UserSpaceUserspace StartPosit StartLen GENDS);                               
                    
      StartPosit OffsetHdr 1;                                                           
                    
      StartLen = %size(ListProfilesDS);                                                     
                    
      //                                                                                    
      ?             // Do for number of outqueues in the userspace                                        
                    //                                                                                    
      B1            for count 1 to  NbrInList;                                                          
                     
      $UserSpaceUserspace StartPosit :                                                 
                     
      StartLen ListProfilesDS);                                                          
                     
      StartPosit += SizeEntry;                                                             

                     
      // retrieve the device description                                                   
                     
      $RtvObjDObjectDS                                                                   
                               
      : %SizeObjectDS )                                                        
                               : 
      'OBJD0400'                                                               
                               
      ListProfilesDS.Object +                                                  
                                 
      ListProfilesDS.library                                                   
                               
      ListProfilesDS.ObjectType                                                
                               
      ApiErrorDS                                                               
                                                
      );                                                        
                     
      // get user profile status -- enabled or disabled                                    

                     
      ProfileDataDS =                                                                      
                      
      GetUserProfileData(ListProfilesDS.Object);                                          

                     if 
      ProfileDataDS.Status '*DISABLED' and                                            
                      %
      lookup(ListProfilesDS.Object:Profiles(*).name) = *zeros;                           
                      
      Outsubject 'userid ' + %trim(ListProfilesDS.Object) +                             
                                   
      ' is *Disabled.';                                                      
                      
      Outmessage 'Please *ENABLE Profile';                                              
                      
      exsr $sendusermessage;                                                              
                     endif;                                                                               

                    endfor;                                                                               

                   
      endsr;                                                                                 
              
      //===========================================                                               
              // $CheckUnattachedJobs                                                                     
              //===========================================                                               

                   
      begsr $CheckUnattachedJobs;                                                            

                    
      exec sql                                                                              
                     
      declare C1 scroll cursor for                                                         
                     
      select                                                                               
                      uJKEY
      UJDSC ujcst                                                                
                      from UJBCTL                                                                         
                      where ujcst not in 
      ('1''3''4')                                                  
                     for 
      read only;                                                                       

                    
      exec sql open C1;                                                                     
                    
      exec sql fetch first from C1 for :MaxItemLines rows into :C1;                         
                    
      exec sql get diagnostics :RowCount ROW_COUNT;                                       
                    
      DoW RowCount <> 0;                                                                    
                     For 
      1 to RowCount;                                                               

                      
      OutSubject 'Unattached Job in Error';                                             
                      
      OutMessage 'Job: ' + %trim(c1(i).program) +  '-' +                                
                                   %
      trim(c1(i).description) +  ' In status ' +                            
                                   %
      trim(c1(i).code);                                                     
                      
      exsr $sendusermessage;                                                              

                     EndFor;                                                                              
                     
      exec sql fetch next from C1 for :MaxItemLines rows into :C1;                         
                     
      exec sql get diagnostics :RowCount ROW_COUNT;                                      
                    
      EndDo;                                                                                
                    
      exec sql close C1;                                                                    

                   
      endsr;                                                                                 

             
      // *************************************************************                             
             // send messages to users                                                                    
             // *************************************************************                             

             
      begsr $sendusermessage;                                                                      

                 
      // get the system name                                                                   
                 
      exec sql                                                                                 
                  values current server                                                                   
                  into 
      :SystemName;                                                                       

                 
      OutSubject = %trim(ReturnSystemName) +'-' + %trim(OutSubject);                           
                 
      MyFullMessage =  OutSubject OutMessage;                                                


                 
      // check last time you sent this message against value in  delayMinutes                  
                  
      foundmessage = %lookup(MyFullMessage:sentmessages(*).Message);                          
                  if 
      foundmessage > *zeros;                                                               
                     
      totalMinutes = %diff(%timestamp:                                                     
                    
      sentmessages(foundmessage).messagetime:*minutes);                                     

                   if 
      totalminutes delayminutes;                                                        

                    
      // send message                                                                       
                    
      IsThereAnError RouteOutput(@PGM:                                                    
                                                 
      'MESSAGE':                                               
                                                  @
      PGM:                                                   
                                                  
      OutSubject:                                             
                                                  
      OutMessage:                                             
                                                  
      0);                                                     

                    
      sentmessages(foundmessage).messagetime = %timestamp();                                
                   endif;                                                                                 
                  else;                                                                                   

                    
      // send message                                                                       
                    
      IsThereAnError RouteOutput(@PGM:                                                    
                                                 
      'MESSAGE':                                               
                                                  @
      PGM:                                                   
                                                  
      OutSubject:                                             
                                                  
      OutMessage:                                             
                                                  
      0);                                                     

                   
      MM#+=1;                                                                                
                   
      sentmessages(mm#).message = MyFullMessage;                                             
                   
      sentmessages(mm#).messagetime = %timestamp();                                          
                  
      endif;                                                                                  
             
      endsr;                                                                                       

            /
      end-free 
      Attached Files
      All my answers were extracted from the "Big Dummy's Guide to the As400"
      and I take no responsibility for any of them.

      www.code400.com

      Comment


      • Ascidious
        Ascidious commented
        Editing a comment
        Jamief, I want to thank you for a very detailed code. I would definitely go with killing a mosquito with a canon lol. Unfortunately, I am brand new to rpg/cl programs and its language, so it is going to take me some time to comb through this code and really figure out what I need and how it works, which i will start working on now. However, if you happen to know of a way to simplify this so that all it does, is check a specific printer q, loop through any spool file there, and return the spool file's creation date and time to a variable, so it can be compared current date and time, to see its age, thats what im looking for.

    • #8
      RTVSPLA has Open Date and Open Time, which I think is the same thing. The QUSRSPLA API outputs Open Date/Time and its documentation says they are the same thing as Created Date/Time.

      I suppose because spool files are written one line at a time over a possibly long time, so the date/time specifically refers to when the program writing the spool opened it for writing, as distinct from when it stopped writing and and closed the file.

      Comment


      • #9
        Another option would be to monitor the message queue associated with the printer - chances are it spits a message when it "hangs up".

        Cheers,

        Emmanuel

        Comment

        Working...
        X