星期四, 11月 09, 2023

2015-06-05 如何監控系統中執行狀態為 MSGW 的工作,並傳送訊息至 MSGQ 或 Email?(Command CHKJOBMSGW -- Check Job Message Wait with QGYOLJOB Open list of jobs API)


如何監控系統中執行狀態為 MSGW 的工作,並傳送訊息至 MSGQ 或 Email?(Command CHKJOBMSGW -- Check Job Message Wait with QGYOLJOB Open list of jobs API)

File  : QRPGLESRC

Member: CHKJOBMSGW

Usage : CRTBNDRPG PGM(CHKJOBMSGW)   


     **
     **  Program . . : CHKJOBMSGW
     **  Description : Check job msgw and send msgw info to msgq or mail
     **  Author  . . : Vengoal Chang
     **  Published . : AS400ePaper
     **  Date  . . . : June 5, 2015
     **
     **
     **  Program summary
     **  ---------------
     **
     **  Work management APIs:
     **    QGYOLJOB      Open list of jobs     Lists jobs on the system based on
     **                                        the specified selection criteria.
     **
     **                                        Optionally a sort order for the
     **                                        returned jobs can be specified -
     **                                        in this case the jobname first
     **
     **    QWVRCSTK      Retrieve Call Stack   Lists the program call stack for
     **                                        the specified job or thread.
     **                                        The current invocation level is
     **                                        returned first.
     **
     **  Message handling API:
     **    QMHSNDM       Send message          Sends a message to the specified
     **                                        non-program message queue - here
     **                                        an informational message is sent
     **                                        to the current user running this
     **                                        program.
     **
     **    QMHRTVM       Retrieve Message      Retrieves the message description
     **                                        of a predefined message.
     **
     **  Open list APIs:
     **    QGYGTLE       Get list entries      To retrieve open lists entries
     **                                        from an already open list the
     **                                        QGYGTLE (Get List Entries) API
     **                                        is available.
     **
     **    QGYCLST       Close list            This API closes the previously
     **                                        opened list identified by the
     **                                        request handle parameter.
     **                                        Storage allocated is freed.
     **
     **  MI builtins:
     **    _MEMMOVE      Copy memory           Copies a string from one pointer
     **                                        specified location to another.
     **
     **  Unix Type - Signal APIs:
     **    Sleep                               Suspends program processing for
     **                                        the specified number of seconds.
     **
     **
     **  Sequence of events:
     **    1. The list jobs API input parameters are initialized
     **
     **    2. The open list of jobs API is called
     **
     **    3. For each job get key data
     **       101  Active job status
     **       305  Current user profile
     **       1307 Message reply
     **       1308 Message key, when active job waiting for a message
     **       1309 Message queue name - qualified, when active job waiting for a message
     **       1906 Subsystem description name - qualified
     **
     **       List job name and check whether job waiting message or not.
     **       If job wait for a reply to a message, send message to user
     **       which run the CHKJOBMSGW program.
     **
     **    4. The job list resources are cleaned up.
     **
     **    5. Sleep wakeup interval, then go to step 2. lsit msgw job
     **
     **
     **
     **  Programmer's notes:
     **    To retrieve another job's call stack *JOBCTL special authority is
     **    required.
     **
     **
     **  Compile options:
     **
     **    CrtBndPgm Pgm( CHKJOBMSGW )
     **
     **-- Control spec:  -----------------------------------------------------**
     H Option( *SrcStmt )  DecEdit( *JobRun )  BndDir( 'QC2LE' )
     H DftActGrp(*NO) Debug
     **-- System information:  -----------------------------------------------**
     D PgmSts         SDs
     D  PsPgmNam         *Proc
     D  PsSts                         5a   Overlay( PgmSts:  11 )
     D  PsCurJob                     10a   Overlay( PgmSts: 244 )
     D  PsUsrPrf                     10a   Overlay( PgmSts: 254 )
     D  PsJobNbr                      6a   Overlay( PgmSts: 264 )
     D  PsCurUsr                     10a   Overlay( PgmSts: 358 )
     **-- API error data structure:  -----------------------------------------**
     D ApiError        Ds
     D  AeBytPrv                     10i 0 Inz( %Size( ApiError ))
     D  AeBytAvl                     10i 0
     D  AeExcpId                      7a
     D                                1a
     D  AeExcpDta                   128a
     **-- API parameters:  ---------------------------------------------------**
     D JlRtnRcdNbr     s             10i 0 Inz( 1 )
     D JlNbrFldRtn     s             10i 0 Inz( %Elem( JlKeyFld ))
     D JlKeyFld        s             10i 0 Dim( 6 )
     **-- Job information OLJB0300:
     D*JlJobInf0300    Ds           512
     D* JbJobId                      26a
     D*  JbJobUsd                    10a   Overlay( JbJobId: 1 )
     D*  JbUsrUsd                    10a   Overlay( JbJobId: *Next )
     D*  JbNbrUsd                     6a   Overlay( JbJobId: *Next )
     D* JbActSts                      4a
     D* JbJobTyp                      1a
     D* JbJobSubTyp                   1a
     D* JbDtaLen                     10i 0
     D*                               4a
     D* JbDta                       256a
     **-- Job information OLJB0200:
     D JlJobInf        Ds           512
     D  JbJobId                      26a
     D   JbJobUsd                    10a   Overlay( JbJobId: 1 )
     D   JbUsrUsd                    10a   Overlay( JbJobId: *Next )
     D   JbNbrUsd                     6a   Overlay( JbJobId: *Next )
     D  JbJobIntId                   16a
     D  JbJobSts                     10a
     D  JbJobTyp                      1a
     D  JbJobSubTyp                   1a
     D                                2a
     D  JbJobInfoSts                  1a
     D                                3a
     D  JbDta                       256a
     **-- Key information:
     D JlKeyInf        Ds
     D  KiFldNbrRtn                  10i 0
     D  KiKeyInf                     20a   Dim( %Elem( JlKeyFld ))
     D   KiFldInfLen                 10i 0 Overlay( KiKeyInf :  1 )
     D   KiKeyFld                    10i 0 Overlay( KiKeyInf :  5 )
     D   KiDtaTyp                     1a   Overlay( KiKeyInf :  9 )
     D                                3a   Overlay( KiKeyInf : 10 )
     D   KiDtaLen                    10i 0 Overlay( KiKeyInf : 13 )
     D   KiDtaOfs                    10i 0 Overlay( KiKeyInf : 17 )
     **-- Sort information:
     D JlSrtInf        Ds
     D  SiNbrKeys                    10i 0 Inz( 1 )
     D  SiSrtInf                     12a   Dim( 10 )
     D   SiKeyFldOfs                 10i 0 Overlay( SiSrtInf :  1 )
     D   SiKeyFldLen                 10i 0 Overlay( SiSrtInf :  5 )
     D   SiKeyFldTyp                  5i 0 Overlay( SiSrtInf :  9 )
     D   SiSrtOrd                     1a   Overlay( SiSrtInf : 11 )
     D   SiRsv                        1a   Overlay( SiSrtInf : 12 )
     **-- List information:
     D JlLstInf        Ds
     D  LiRcdNbrTot                  10i 0
     D  LiRcdNbrRtn                  10i 0
     D  LiHandle                      4a
     D  LiRcdLen                     10i 0
     D  LiInfSts                      1a
     D  LiDts                        13a
     D  LiLstSts                      1a
     D                                1a
     D  LiInfLen                     10i 0
     D  LiRcd1                       10i 0
     D                               40a
     **-- Selection information:
     D JlSltInf        Ds
     D  SiJobNam                     10a   Inz( '*ALL' )
     D  SiUsrNam                     10a   Inz( '*ALL' )
     D  SiJobNbr                      6a   Inz( '*ALL' )
     D* SiJobTyp                      1a   Inz( 'I' )
     D  SiJobTyp                      1a   Inz( '*' )
     D                                1a
     D  SiOfsPriSts                  10i 0 Inz(108 )
     D  SiNbrPriSts                  10i 0 Inz( 1 )
     D  SiOfsActSts                  10i 0 Inz(118 )
     D  SiNbrActSts                  10i 0 Inz( 1 )
     D  SiOfsJbqSts                  10i 0 Inz(126 )
     D  SiNbrJbqSts                  10i 0 Inz( 0 )
     D  SiOfsJbqNam                  10i 0 Inz(136 )
     D  SiNbrJbqNam                  10i 0 Inz( 0 )
     D  SiOfsCurUsr                  10i 0 Inz(156 )
     D  SiNbrCurUsr                  10i 0 Inz( 0 )
     D  SiOfsSvrTyp                  10i 0 Inz(166 )
     D  SiNbrSvrTyp                  10i 0 Inz( 0 )
     D  SiOfsActSbs                  10i 0 Inz(196 )
     D  SiNbrActSbs                  10i 0 Inz( 0 )
     D  SiOfsMemPol                  10i 0 Inz(206 )
     D  SiNbrMemPol                  10i 0 Inz( 0 )
     D  SiOfsJobTypE                 10i 0 Inz(210 )
     D  SiNbrJobTypE                 10i 0 Inz( 0 )
     D  SiOfsQualJob                 10i 0 Inz(214 )
     D  SiNbrQualJob                 10i 0 Inz( 0 )
     **
     D  SiPriSts                     10a   Dim( 1 )
     D  SiActSts                      4a   Dim( 2 )
     D  SiJbqSts                     10a   Dim( 1 )
     D  SiJbqNam                     20a   Dim( 1 )
     D  SiCurUsr                     10a   Dim( 1 )
     D  SiSvrTyp                     30a   Dim( 1 )
     D  SiActSbs                     10a   Dim( 1 )
     D  SiMemPol                     10i 0 Dim( 1 )
     D  SiJobTypEn                   10i 0 Dim( 1 )
     D  SiQualJob                    26    Dim( 1 )
     **-- Job information key fields:
     D JbKeyDta        Ds
     D  JbCurUSr                     10
     D  JbMsgRpy                      1
     D  JbMsgKeyRpy                   4
     D  JbMsgQRpy                    20
     D  JbQualSbs                    20
     **-- General return data:
     D JlGenDta        Ds
     D  GdBytRtn                     10i 0
     D  GdBytAvl                     10i 0
     D  GdElpTim                     20u 0
     D                               16a
     **-- API constants:  ----------------------------------------------------**
     D JOB_RESET_STAT  c                   '1'
     D JOB_KEEP_STAT   c                   '0'
     **-- Open list of jobs:  ------------------------------------------------**
     D LstJobs         Pr                  ExtPgm( 'QGYOLJOB' )
     D  LjRcvVar                  65535a          Options( *VarSize )
     D  LjRcvVarLen                  10i 0 Const
     D  LjFmtNam                      8a   Const
     D  LjRcvVarDfn               65535a          Options( *VarSize )
     D  LjRcvDfnLen                  10i 0 Const
     D  LjLstInf                     80a
     D  LjNbrRcdRtn                  10i 0 Const
     D  LjSrtInf                   1024a   Const  Options( *VarSize )
     D  LjJobSltInf                1024a   Const  Options( *VarSize )
     D  LjJobSltLen                  10i 0 Const
     D  LjNbrFldRtn                  10i 0 Const
     D  LjKeyFldRtn                  10i 0 Const  Options( *VarSize )  Dim( 32 )
     D  LjError                    1024a          Options( *VarSize )
     **
     D  LjJobSltFmt                   8a   Const  Options( *NoPass )
     **
     D  LjResStc                      1a   Const  Options( *NoPass )
     D  LjGenRtnDta                  32a          Options( *NoPass: *VarSize )
     D  LjGenRtnDtaLn                10i 0 Const  Options( *NoPass )
     **-- Get list entry:  ---------------------------------------------------**
     D GetLstEnt       Pr                  ExtPgm( 'QGYGTLE' )
     D  GlRcvVar                  65535a          Options( *VarSize )
     D  GlRcvVarLen                  10i 0 Const
     D  GlHandle                      4a   Const
     D  GlLstInf                     80a
     D  GlNbrRcdRtn                  10i 0 Const
     D  GlRtnRcdNbr                  10i 0 Const
     D  GlError                    1024a          Options( *VarSize )
     **-- Close list:  -------------------------------------------------------**
     D CloseLst        Pr                  ExtPgm( 'QGYCLST' )
     D  ClHandle                      4a   Const
     D  ClError                    1024a          Options( *VarSize )
     **-- Send message:  -----------------------------------------------------**
     D SndMsg          Pr                  ExtPgm( 'QMHSNDM' )
     D  SmMsgId                       7a   Const
     D  SmMsgFq                      20a   Const
     D  SmMsgDta                    512a   Const Options( *VarSize )
     D  SmMsgDtaLen                  10i 0 Const
     D  SmMsgTyp                     10a   Const
     D  SmMsgQq                    1000a   Const Options( *VarSize )
     D  SmMsgQnbr                    10i 0 Const
     D  SmMsgQrpy                    20a   Const
     D  SmMsgKey                      4a
     D  SmError                      10i 0 Const
     **
     D  SmCcsId                      10i 0 Const Options( *NoPass )
     **-- Copy memory:  ------------------------------------------------------**
     D memcpy          Pr              *   ExtProc( '_MEMMOVE' )
     D  outmem                         *   Value
     D  inpmem                         *   Value
     D  memsiz                       10u 0 Value
     **-- Delay job:  --------------------------------------------------------**
     D sleep           Pr            10i 0 ExtProc( 'sleep' )
     D  seconds                      10u 0 Value
     **-- Get top stack entry:  ----------------------------------------------**
     D GetTopStkE      Pr            20a
     D  GtJobId                      26a   Const
      *** Prototypes for external subprocedures:
     D Cmd             PR                  ExtPgm('QCMDEXC')
     D   command                   4096A   OPTIONS(*VARSIZE) CONST
     D   length                      15P 5 const

     D tmpnam          PR              *   extproc('_C_IFS_tmpnam')
     D   string                      39A   options(*omit)

     D filename        S             40A   Varying
     D fd              S             10I 0
     D CRLF            S              2    INZ(X'0D25')

     **-- Receive non-program message:
     D RcvMsg          Pr                  ExtPgm( 'QMHRCVM' )
     D  RcvVar                    65535a          Options( *VarSize )
     D  RcvVarLen                    10i 0 Const
     D  FmtNam                       10a   Const
     D  MsgQueQ                      20a   Const
     D  MsgTyp                       10a   Const
     D  MsgKey                        4a   Const
     D  Wait                         10i 0 Const
     D  MsgAct                       10a   Const
     D  Error                     32767a          Options( *VarSize )
     D  CcsId                        10i 0 Const  Options( *NoPass )
     D  AlwDftRpyRjt                 10i 0 Const  Options( *NoPass )
     **-- Message information structure:
     D RCVM0200        Ds                  Qualified
     D  BytRtn                       10i 0
     D  BytAvl                       10i 0
     D  MsgSev                       10i 0
     D  MsgId                         7a
     D  MsgTyp                        2s 0
     D  MsgKey                        4a
     D  MsgFilNam                    10a
     D  MsgFilLib_s                  10a
     D  MsgFilLib_u                  10a
     D  SndJobNam                    10a
     D  SndJobUsr                    10a
     D  SndJobNbr                     6a
     D  SndPgmNam                    12a
     D                                4a
     D  DatSnt                        7s 0
     D  TimSnt                        6s 0
     D  TimSntMs                      6s 0
     D  SndUsrPrf                    10a
     D                                1a
     D  CcsIdStsTxt                  10i 0
     D  CcsIdStsDta                  10i 0
     D  AlrOpt                        9a
     D  CcsIdMsgTxt                  10i 0
     D  CcsIdMsgDta                  10i 0
     D  DtaLenRtn                    10i 0
     D  DtaLenAvl                    10i 0
     D  MsgLenRtn                    10i 0
     D  MsgLenAvl                    10i 0
     D  HlpLenRtn                    10i 0
     D  HlpLenAvl                    10i 0
     D  VarDta                    32767a
     **
     **
     D MsqNam_q        Ds
     D  ObjNam                       10a
     D  LibNam                       10a

     D DateSentC       S             19
     D DateSent        Ds            13
     D DateSnt                        7s 0
     D TimeSnt                        6s 0
     D SentYY                         2    overlay(DateSent:2)
     D SentMM                         2    overlay(DateSent:4)
     D SentDD                         2    overlay(DateSent:6)
     D SentHH                         2    overlay(DateSent:8)
     D SentMin                        2    overlay(DateSent:10)
     D Sentss                         2    overlay(DateSent:12)

     **-- Global variables:  -------------------------------------------------**
     D PgmNam          s             20a
     D MsgDta          s            256a   Varying
     D MsgKey          s              4a
     D MsgTyp          s             10a
     D Subject         s             60a
     D PgmJob          s            100a
     D MsgTxt          s           1024a   Varying
     D MsgHlpTxt       s           1024a   Varying
     D SecLvlMsgTxt    s           2048a   Varying
     D SecLvl          s           4096a   Varying
     D MailText        s           2048a   Varying
     D tempText        s           2048a
     D Ix              s              5i 0
     D Offset          s              5i 0
     D Pos             s              5i 0
     D CmdStr          S           4096
     D QualMsgQ        S             20

     D SecLvlFmt       s             78a   Dim( 64 )
     D MsgTxtFmt       s             78a   Dim( 64 )
     D NbrLinMsg       s              5i 0
     D NbrLinSec       s              5i 0
     D LinIdx          s              5i 0
     D SysDts          s               z
     D Idx             s              5i 0
     D IfsCcsid        s             10U 0
     **-- Global constants:
     D OFS_MSGDTA      c                   16
     D JOB_CCSID       c                   0
     D RPY_SENT        c                   '2'
     D TYP_INQ         c                   5
     D TYP_RPY         c                   21
     D MSG_TXT         c                   '&N Message . . . . :   '
     D RPY_DTA         c                   'Reply . . . . . :   '
     D NO_WAIT         c                   0
     D KEEP_STS        c                   '*SAME'
     D NULL            c                   ''
     D WAIT_MAX        c                   -1
     D OLD_STS         c                   '*OLD'
     D QUOTE           C                   X'7D'

     D*  Flags for use in open()
     D O_RDWR          C                   4
     D*                                            Create File if not exist
     D O_CREAT         C                   8
     D*                                            Exclusively create
     D O_EXCL          C                   16
     D*                                            Assign a CCSID
     D O_CCSID         C                   32
     D*                                            Truncate File to 0 bytes
     D O_TRUNC         C                   64
     D*                                            Writing Only
     D O_WRONLY        C                   2
     D O_TEXTDATA      C                   16777216
     D* Note: O_TEXT_CREAT requires all of the following flags to work:
     D*           O_CREAT+O_TEXTDATA+(O_CODEPAGE or O_CCSID)
     D O_TEXT_CREAT    C                   33554432

     D*                                         owner authority
     D S_IRUSR         C                   256
     D S_IWUSR         C                   128

     D*--------------------------------------------------------------------
     D* Open a File
     D open            PR            10I 0 ExtProc('open')
     D  filename                       *   value options(*string)
     D  openflags                    10I 0 value
     D  mode                         10U 0 value options(*nopass)
     D  codepage                     10U 0 value options(*nopass)
     D  txtcreatid                   10U 0 value options(*nopass)

     D*--------------------------------------------------------------------
     D* Close a file
     D close           PR            10I 0 ExtProc('close')
     D  handle                       10I 0 value

     D*--------------------------------------------------------------------
     D* Remove Link to File.
     D unlink          PR            10I 0 ExtProc('unlink')
     D   path                          *   Value options(*string)
     D*--------------------------------------------------------------------
     D* Write to a file
     D write           PR            10I 0 ExtProc('write')
     D  handle                       10I 0 value
     D  buffer                         *   value
     D  bytes                        10U 0 value

     **-- Retrieve message:
     D RtvMsg          Pr                  ExtPgm( 'QMHRTVM' )
     D  RcvVar                    32767a          Options( *VarSize )
     D  RcvVarLen                    10i 0 Const
     D  FmtNam                       10a   Const
     D  MsgId                         7a   Const
     D  MsgFil_q                     20a   Const
     D  MsgDta                      512a   Const  Options( *VarSize )
     D  MsgDtaLen                    10i 0 Const
     D  RplSubVal                    10a   Const
     D  RtnFmtChr                    10a   Const
     D  Error                     32767a          Options( *VarSize )
     D  RtvOpt                       10a   Const  Options( *NoPass )
     D  CvtCcsId                     10i 0 Const  Options( *NoPass )
     D  RplCcsId                     10i 0 Const  Options( *NoPass )
     **-- Retrieve second level help text:
     D RtvSecLvl       Pr          4096a   Varying
     D  PxMsgFil_q                   20a   Const
     D  PxMsgId                       7a   Const
     D  PxMsgDta                   4096a   Const  Varying
     **-- Format message string:
     D FmtMsgStr       Pr            78a   Dim( 64 )
     D  PxMsgStr                   4096a   Value  Varying
     D  PxNbrLin                      5i 0
     **-- Format message line:
     D FmtMsgLin       Pr            78a
     D  PxMsgLin                     82a   Const  Varying
     D  PxPrcLen                      5i 0
     D  PxInzInd                       n          Options( *NoPass )
     **-- Find format instruction:
     D FndFmtIns       Pr             5u 0
     D  PxMsgLin                     82a   Const  Varying
     D  PxOffSet                      5u 0 Const  Options( *NoPass )
     **-- Get indent positions:
     D GetIndPos       Pr             5u 0
     D  PxFmtIns                      2a   Const
     D  PxInxNxt                      5u 0
     **-- Scan reverse:
     D ScanR           Pr             5u 0
     D  PxArg                       128a   Const  Varying
     D  PxString                   4096a   Const  Varying
     D  PxOfs                         5u 0 Const  Options( *NoPass )

     **-- Check AS400 Object exist ?
     D As400ObjFound   PR              N
     D  QlObjName                    20    Value
     D  ObjType                      10    Value
     **-- Send escape message:
     D SndEscMsg       Pr            10i 0
     D  PxMsgId                       7a   Const
     D  PxMsgF                       10a   Const
     D  PxMsgDta                    512a   Const  Varying
     **-- Send program message:
     D SndPgmMsg       Pr                  ExtPgm( 'QMHSNDPM' )
     D  MsgId                         7a   Const
     D  MsgFq                        20a   Const
     D  MsgDta                      128a   Const
     D  MsgDtaLen                    10i 0 Const
     D  MsgTyp                       10a   Const
     D  CalStkE                      10a   Const  Options( *VarSize )
     D  CalStkCtr                    10i 0 Const
     D  MsgKey                        4a
     D  Error                      1024a          Options( *VarSize )

     **
     **-- Mainline:  ---------------------------------------------------------**
     **

     C     *Entry        Plist
     C                   Parm                    WakeUp            5 0
     C                   Parm                    Mail              4
     C                   Parm                    MsgQ              4
     C                   Parm                    ToMail           32
     C     IfsCcsid      Parm                    CltCCSID          5 0
     C                   Parm                    ToMsgQ           20

     C                   If        MsgQ = '*YES'
     C                   CallP     As400ObjFound( ToMsgQ : '*MSGQ' )
     C                   EndIf

     C                   Eval      SiPriSts(1) = '*ACTIVE'
     C                   Eval      SiActSts(1) = 'MSGW'

     **-- Job information return fields:
     C                   Eval      JlKeyFld(1) = 101
     C                   Eval      JlKeyFld(2) = 305
     C                   Eval      JlKeyFld(3) = 1307
     C                   Eval      JlKeyFld(4) = 1308
     C                   Eval      JlKeyFld(5) = 1309
     C                   Eval      JlKeyFld(6) = 1906
     **
     **-- Sort field specification:
     C                   Eval      SiNbrKeys      = 1
     C                   Eval      SiKeyFldOfs(1) = 1
     C                   Eval      SiKeyFldLen(1) = 10
     C                   Eval      SiKeyFldTyp(1) = 4
     C                   Eval      SiSrtOrd(1)    = '1'
     C                   Eval      SiRsv(1)       = x'00'
     **
     C                   DoW       1 = 1
     **
     **-- Retrieve job list:
     C                   CallP     LstJobs( JlJobInf
     C                                    : %Size( JlJobInf )
     C                                    : 'OLJB0200'
     C                                    : JlKeyInf
     C                                    : %Size( JlKeyInf )
     C                                    : JlLstInf
     C                                    : 1
     C                                    : JlSrtInf
     C                                    : JlSltInf
     C                                    : %Size( JlSltInf )
     C                                    : JlNbrFldRtn
     C                                    : JlKeyFld
     C                                    : ApiError
     C                                    : 'OLJS0200'
     C                                    : JOB_KEEP_STAT
     C                                    : JlGenDta
     C                                    : %Size( JlGenDta )
     C                                    )
     **
     C                   If        AeBytAvl    =  *Zero
     **
     C                   DoW       LiLstSts    <> '2'           Or
     C                             LiRcdNbrTot >  JlRtnRcdNbr
     **
     C                   ExSr      GetKeyDta
     **
     C                   Eval      JlRtnRcdNbr = JlRtnRcdNbr + 1
     **
     C                   CallP     GetLstEnt( JlJobInf
     C                                      : %Size( JlJobInf )
     C                                      : LiHandle
     C                                      : JlLstInf
     C                                      : 1
     C                                      : JlRtnRcdNbr
     C                                      : ApiError
     C                                      )
     **
     C                   If        AeBytAvl    > *Zero
     C                   Leave
     C                   EndIf
     **
     C                   EndDo
     **
     C                   CallP     CloseLst( LiHandle
     C                                     : ApiError
     C                                     )
     **
     **-- Wait 10 seconds:
     C                   CallP     sleep( WakeUp )
     **
     C                   Reset                   JlLstInf
     C                   Eval      JlRtnRcdNbr = 1
     C                   Else
     C                   Leave
     C                   EndIf
     C                   EndDo

     C                   If        AeBytAvl    > *Zero
     C                   CallP     SndEscMsg( AeExcpId
     C                                : 'QCPFMSG'
     C                                : %Subst( AeExcpDta: 1: AeBytAvl- 16 )
     C                                       )
     C                   EndIf
     **
     C                   Eval      *InLr       = *On
     **
     C                   Return
     **
     **-- Get KEY data:  -----------------------------------------------------**
     C     GetKeyDta     BegSr
     **
     C                   Clear                   JbKeyDta
     **
     C                   For       Ix = 1  To KiFldNbrRtn
     **
     C                   Select
     C                   When      KiKeyFld(Ix) = 305
     C                   CallP     memcpy( %Addr( JbCurUsr )
     C                                   : %Addr( JlJobInf ) +
     C                                     KiDtaOfs(Ix)
     C                                   : KiDtaLen(Ix)
     C                                   )
     **
     C                   When      KiKeyFld(Ix) = 1307
     C                   CallP     memcpy( %Addr( JbMsgRpy )
     C                                   : %Addr( JlJobInf ) +
     C                                     KiDtaOfs(Ix)
     C                                   : KiDtaLen(Ix)
     C                                   )
     **
     C                   When      KiKeyFld(Ix) = 1308
     C                   CallP     memcpy( %Addr( JbMsgKeyRpy )
     C                                   : %Addr( JlJobInf ) +
     C                                     KiDtaOfs(Ix)
     C                                   : KiDtaLen(Ix)
     C                                   )
     **
     C                   When      KiKeyFld(Ix) = 1309
     C                   CallP     memcpy( %Addr( JbMsgQRpy   )
     C                                   : %Addr( JlJobInf ) +
     C                                     KiDtaOfs(Ix)
     C                                   : KiDtaLen(Ix)
     C                                   )
     **
     C                   When      KiKeyFld(Ix) = 1906
     C                   CallP     memcpy( %Addr( JbQualSbs )
     C                                   : %Addr( JlJobInf ) +
     C                                     KiDtaOfs(Ix)
     C                                   : KiDtaLen(Ix)
     C                                   )
     C                   EndSl
     C                   EndFor
     **
     C                   If        JbMsgRpy = '1'
     C                   Eval      PgmNam      = GetTopStkE( JbJobId )
     C                   If        MsgQ = '*YES'
     C                   Exsr      SndCmpMsg
     C                   EndIf
     C                   If        Mail = '*YES'
     C                   Exsr      GetMsgTxt
     C                   Exsr      SndMailAtch
     C                   EndIf
     C                   EndIf
     **
     C                   EndSr
     **-- Get Message Text:  -------------------------------------------------**
     C     GetMsgTxt     BegSr
     **
     C                   Eval      MsgTyp = '*INQ'
     C                   Eval      MsgKey = JbMsgKeyRpy
     C                   Eval      MsqNam_q= JbMsgQRpy
     C                   CallP     RcvMsg( RCVM0200
     C                                    : %Size( RCVM0200 )
     C                                    : 'RCVM0200'
     C                                    : MsqNam_q
     C                                    : MsgTyp
     C                                    : MsgKey
     C                                    : NO_WAIT
     C                                    : OLD_STS
     C                                    : ApiError
     C                                    : JOB_CCSID
     C                                   )
     C                   If        RCVM0200.MsgFilLib_u=*Blanks
     C                   eval      RCVM0200.MsgFilLib_u=RCVM0200.MsgFilLib_s
     C                   EndIf

     C                   Eval      MsgDta = %Subst( RCVM0200.VarDta
     C                                            : 1
     C                                            : RCVM0200.DtaLenRtn
     C                                            )
     C                   eval      MsgTxt    = %Subst( RCVM0200.VarDta
     C                                              : RCVM0200.DtaLenRtn + 1
     C                                              : RCVM0200.MsgLenRtn
     C                                               )

     C                   If        RCVM0200.MsgId = *Blanks
     C                   eval      MsgTxt = MsgDta
     C                   Else
     C                   eval      SecLvl = RtvSecLvl( RCVM0200.MsgFilNam +
     C                                                 RCVM0200.MsgFilLib_u
     C                                               : RCVM0200.MsgId
     C                                               : MsgDta
     C                                               )

     C                   eval      SecLvlFmt=FmtMsgStr( SecLvl: NbrLinSec )
     C                   eval      SecLvlMsgTxt = *Blanks
     C                   For       idx = 1 to 64
     C                   If        %len(%trimr(SecLvlFmt(idx))) > 0
     C                   If        %Subst(SecLvlFmt(idx):1:2) <> 'Ca' and
     C                             %Subst(SecLvlFmt(idx):1:2) <> 'Re'
     C                   eval      %Subst(SecLvlFmt(idx):1:2) = '  '
     C                   EndIf
     C                   eval      SecLvlMsgTxt = %trimr(SecLvlMsgTxt) +
     C                                            SecLvlFmt(idx) + CRLF
     C                   Else
     C                   leave
     C                   EndIf
     C                   EndFor
     C                   EndIf
     C
     C                   EndSr
     **-- Send completion message:  ------------------------------------------**
     C     SndCmpMsg     BegSr
     **
     C                   Eval      QualMsgQ = PsCurUsr + '*LIBL'
     C                   If        MsgQ <> *Blanks
     C                   Eval      QualMsgQ = ToMsgQ
     C                   EndIf
     C                   Eval      MsgDta      = 'Program '                   +
     C                                           %Trim(%SubSt(PgmNam:11:10))  +
     C                                           '/'                          +
     C                                           %Trim(%SubSt(PgmNam: 1:10))  +
     C                                           ' in job '                   +
     C                                           %Trim( JbNbrUsd ) + '/'      +
     C                                           %Trim( JbUsrUsd ) + '/'      +
     C                                           %Trim( JbJobUsd )            +
     C                                           ' waiting for a message' +
     C                                           ' in Msgq '                  +
     C                                           %Trim(%SubSt(JbMsgQRpy:11:10))+
     C                                           '/'                          +
     C                                           %Trim(%SubSt(JbMsgQRpy:1:10))+
     C                                           '.'
     **
     C                   CallP(e)  SndMsg( *Blanks
     C                                   : *Blanks
     C                                   : MsgDta
     C                                   : %Len( MsgDta )
     C                                   : '*COMP'
     C                                   : QualMsgQ
     C                                   : 1
     C                                   : *Blanks
     C                                   : MsgKey
     C                                   : 0
     C                                   )
     **
     C                   EndSr
     **-- Send mail message with attach file:  -------------------------------**
     c     SndMailAtch   BegSr
     c                   Eval      DateSnt = RCVM0200.DatSnt
     c                   Eval      TimeSnt = RCVM0200.TimSnt
     c                   Eval      DateSentC = '20' + SentYY + '-' +
     c                                         SentMM + '-' + SentDD + '-' +
     c                                         SentHH + ':' + SentMIN+ ':' +
     c                                         SentSS
     C                   Eval      PgmJob      = 'Program '                   +
     C                                           %Trim(%SubSt(PgmNam:11:10))  +
     C                                           '/'                          +
     C                                           %Trim(%SubSt(PgmNam: 1:10))  +
     C                                           ' error in job '             +
     C                                           %Trim( JbNbrUsd ) + '/'      +
     C                                           %Trim( JbUsrUsd ) + '/'      +
     C                                           %Trim( JbJobUsd )

     C                   Eval      MailText =
     C                                     %trim(PgmJob) + CRLF           +
     C                                     'Time sent: '+DateSentc+' '+
     C                                      CRLF                           +
     C                                     'Message ID: '                  +
     C                                      RCVM0200.MsgId  + CRLF         +
     C                                      'Message: ' + %trim(MsgTxt)  +
     C                                      CRLF + CRLF

     C*                  Eval      filename = %str(tmpnam(*OMIT))
     C                   Eval      filename = '/tmp/'                   +
     C                                        'Error_'+ %trim(JbJobUsd) +
     C                                        '_' + %trim(JbUsrUsd) +
     C                                        '_' + %trim(JbNbrUsd) +
     C                                        '.TXT'

     C                   callp     unlink(filename)
     C
     C                   Eval      fd = open( filename
     C                                       : O_CREAT + O_CCSID+ O_WRONLY
     C                                         + O_TEXT_CREAT + O_TEXTDATA
     C                                       : S_IRUSR + S_IWUSR
     C                                       : IfsCcsid
     C                                       : 0 )
     C
     C                   if        fd = -1
     C* open failed, check errno for the reason why.
     C                   endif

     C                   callp     write(fd: %addr(MailText)+2
     C                                     : %len(%trim(MailText)))
     C
     C                   If        %len(SecLvlMsgTxt) > 0
     C                   callp     write(fd: %addr(SecLvlMsgTxt)+2
     C                                     : %len(%trim(SecLvlMsgTxt)))
     C                   EndIf

     C                   callp     close(fd)

     C
     C                   Eval      Subject     = 'AS400 program '             +
     C                                           %Trim(%SubSt(PgmNam:11:10))  +
     C                                           '/'                          +
     C                                           %Trim(%SubSt(PgmNam: 1:10))  +
     C                                           ' exception occurred.'
     C                   EVAL      cmdSTR = 'SNDSMTPEMM  RCP('             +
     C                                      %trim(ToMail)                  +
     C                                      ') SUBJECT(' + QUOTE +
     C                                      %trim(Subject)     +
     C                                      QUOTE + ') NOTE('              +
     C                                      QUOTE +
     C                                      %trim( MailText)               +
     C                                      QUOTE + ') ATTACH('            +
     C                                      QUOTE                          +
     C                                      %trim(filename)                +
     C                                      QUOTE + ')'
     C*                                     ' CONTENT(*HTML)'
     C                   callp(e)  Cmd(%trim(cmdStr) : %len(%trim(cmdstr)))
     C                   callp     unlink(filename)

     c                   EndSr
     **-- Get top stack entry:  ----------------------------------------------**
     P GetTopStkE      B                   Export
     D                 Pi            20a
     D  GtJobId                      26a   Const
     **-- API parameters:
     D CsRcvVar        Ds
     D  CsBytRtn                     10i 0
     D  CsBytAvl                     10i 0
     D  CsNbrStkE                    10i 0
     D  CsOfsStkE                    10i 0
     D  CsNbrEntRtn                  10i 0
     D  CsThrId                       8a
     D  CsInfSts                      1a
     D  CsCalStk                  32767a
     **
     D CsCalStkE       Ds                  Based( pCalStkE )
     D  CsStkEntLen                  10i 0
     D  CsOfsStmIds                  10i 0
     D  CsNbrStmIds                  10i 0
     D  CsOfsPrcNam                  10i 0
     D  CsLenPrcNam                  10i 0
     D  CsRqsLvl                     10i 0
     D  CsPgmNam                     10a
     D  CsPgmLib                     10a
     D  CsMiInst                     10i 0
     D  CsModNam                     10a
     D  CsModLib                     10a
     D  CsCtlBdy                      1a
     D  CsRsv                         3a
     D  CsActGrpNbr                  10u 0
     D  CsActGrpNam                  10a
     D  CsAddInf                   4096a
     **
     D  CsStmIds                     10a   Dim( 16 )
     D  CsPrcNam                    512a
     **
     D CsJobId         Ds
     D  JiJobId                      26a
     D   JiJobNam                    10a   Overlay( JiJobId: 1 )
     D   JiUsrNam                    10a   Overlay( JiJobId: *Next )
     D   JiJobNbr                     6a   Overlay( JiJobId: *Next )
     D  JiIntId                      16a
     D  JiRsv                         2a   Inz( *Allx'00' )
     D  JiThrInd                     10i 0 Inz( 2 )
     D  JiThrId                       8a   Inz( *Allx'00' )
     **-- Retrieve call stack:
     D RtvCalStk       Pr                  ExtPgm( 'QWVRCSTK' )
     D  RcRcvVar                  32767a
     D  RcRcvVarLen                  10i 0 Const
     D  RcRcvInfFmt                   8a   Const
     D  RcJobId                      56a   Const
     D  RcJobIdFmt                    8a   Const
     D  RcError                   32767a          Options( *VarSize )
     **
     D EntNbr          s              5u 0
     **-- Get stack entries:  ------------------------------------------------**
     **
     C                   Eval      JiJobId     =  GtJobId
     **
     C                   CallP     RtvCalStk( CsRcvVar
     C                                      : %Size( CsRcvVar )
     C                                      : 'CSTK0100'
     C                                      : CsJobId
     C                                      : 'JIDF0100'
     C                                      : ApiError
     C                                      )
     **
     C                   If        AeBytAvl    = *Zero
     C                   Eval      pCalStkE    = %Addr( CsRcvVar ) + CsOfsStkE
     **
     C                   For       EntNbr = 1  to CsNbrEntRtn
     **
     C*                  If        EntNbr      = 1
     **
     C                   Eval      CsStmIds    = *Blanks
     C                   Eval      CsPrcNam    = *Blanks
     **
     C                   If        CsOfsStmIds > *Zero
     C                   CallP     MemCpy( %Addr( CsStmIds )
     C                                   : %Addr( CsCalStkE ) +
     C                                     CsOfsStmIds
     C                                   : CsNbrStmIds * %Size( CsStmIds )
     C                                   )
     C                   EndIf
     **
     C                   If        CsOfsPrcNam > *Zero
     C                   CallP     MemCpy( %Addr( CsPrcNam )
     C                                   : %Addr( CsCalStkE ) +
     C                                     CsOfsPrcNam
     C                                   : CsLenPrcNam
     C                                   )
     C                   EndIf
     **
     C*                  Leave
     C*                  EndIf
     C                   If        %SubSt(CsPgmNam:1:1) <> 'Q'
     C                   Leave
     C                   EndIf
     **
     C                   If        EntNbr      < CsNbrEntRtn
     C                   Eval      pCalStkE    = PCalStkE    + CsStkEntLen
     C                   EndIf
     C                   EndFor
     **
     C                   Return    CsPgmNam + CsPgmLib
     **
     C                   Else
     C                   Return    *Blanks
     C                   EndIf
     **
     P GetTopStkE      E
     **-- Retrieve second level help text:
     P RtvSecLvl       B
     D                 Pi          4096a   Varying
     D  PxMsgFil_q                   20a   Const
     D  PxMsgId                       7a   Const
     D  PxMsgDta                   4096a   Const  Varying

     **-- Message information structure:
     D RTVM0100        Ds                  Qualified
     D  BytRtn                       10i 0
     D  BytAvl                       10i 0
     D  RtnMsgLen                    10i 0
     D  RtnMsgAvl                    10i 0
     D  RtnHlpLen                    10i 0
     D  RtnHlpAvl                    10i 0
     D  Msg                        4096a
     **
     D RPL_SUB_VAL     c                   '*YES'
     D INC_FMT_CTL     c                   '*YES'

      /Free

        RtvMsg( RTVM0100
              : %Size( RTVM0100 )
              : 'RTVM0100'
              : PxMsgId
              : PxMsgFil_q
              : PxMsgDta
              : %Len( PxMsgDta )
              : RPL_SUB_VAL
              : INC_FMT_CTL
              : ApiError
              );

        If  AeBytAvl > *Zero;
          Return  NULL;

        Else;
          Return  %Subst( RTVM0100.Msg
                        : RTVM0100.RtnMsgLen + 1
                        : RTVM0100.RtnHlpLen
                        );
        EndIf;

      /End-Free

     P RtvSecLvl       E
     **-- Format message string:
     P FmtMsgStr       B
     D                 Pi            78a   Dim( 64 )
     D  PxMsgStr                   4096a   Value  Varying
     D  PxNbrLin                      5i 0

     **-- Local variables:
     D InzInd          s               n   Inz( *On )
     D LinIdx          s              5i 0
     D PrcLen          s              5i 0
     D StrPos          s             10i 0 Inz( 1 )
     D RtnFmt          s             78a   Dim( 64 )

      /Free

        If  PxMsgStr > *Blanks;

          For  LinIdx = 1  To  %Elem( RtnFmt );
            RtnFmt(LinIdx) = FmtMsgLin( %TrimL( PxMsgStr ): PrcLen: InzInd );

            If  %Len( %TrimL( PxMsgStr )) > PrcLen;
              PxMsgStr = %Subst( %TrimL( PxMsgStr ): PrcLen + 1 );
            Else;
              Leave;
            EndIf;

            If  PxMsgStr = *Blanks;
              Leave;
            EndIf;
          EndFor;
        EndIf;

        PxNbrLin = LinIdx;

        Return  RtnFmt;

      /End-Free

     P FmtMsgStr       E
     **-- Format message line:
     P FmtMsgLin       B
     D                 Pi            78a
     D  PxMsgLin                     82a   Const  Varying
     D  PxPrcLen                      5i 0
     D  PxInzInd                       n          Options( *NoPass )

     **-- Local variables:
     D IndPos          s              5u 0 Inz( 1 )  Static
     D IndNxt          s              5u 0 Inz( 1 )  Static
     D StrLen          s              5u 0
     D FmtPos          s              5u 0
     D FmtIns          s              2a
     D FmtBeg          s               n
     D LeadBlk         s             10i 0
     **
     D MsgLin          Ds                  Qualified
     D  LstPos                        1a   Overlay( MsgLin: 78 )
     D  NxtPos                        1a   Overlay( MsgLin: 79 )

      /Free

        If  %Parms = 3  And  PxInzInd = *On;
          Reset  IndPos;
          Reset  IndNxt;

          PxInzInd = *Off;
        EndIf;

        FmtBeg = *Off;
        FmtPos = FndFmtIns( PxMsgLin );

        If  FmtPos > *Zero;
          FmtIns = %Subst( PxMsgLin: FmtPos: 2 );

          If  FmtPos = 1;
            FmtBeg = *On;

            IndPos = GetIndPos( FmtIns: IndNxt );
            FmtPos = FndFmtIns( PxMsgLin: 4 );

            If  FmtPos > *Zero;
              %Subst( MsgLin: IndPos ) = %Subst( PxMsgLin: 4: FmtPos - 4 );
            Else;
              %Subst( MsgLin: IndPos ) = %Subst( PxMsgLin: 4 );
            EndIf;

          Else;
            %Subst( MsgLin: IndPos ) = %Subst( PxMsgLin: 1: FmtPos - 1 );
          EndIf;

        Else;
          %Subst( MsgLin: IndPos ) = %Subst( PxMsgLin: 1 );
        EndIf;

        LeadBlk = %Check( ' ': MsgLin );

        If  LeadBlk > *Zero;
          LeadBlk -= IndPos;
        EndIf;

        IndPos = IndNxt;

        If  MsgLin.LstPos = *Blank  Or  MsgLin.NxtPos = *Blank;
          StrLen = %Size( MsgLin ) - 1;
        Else;
          StrLen = ScanR( ' ': MsgLin ) - 1;

          If  StrLen = *Zero;
            StrLen = %Size( MsgLin ) - 1;
          EndIf;
        EndIf;

        MsgLin = %Subst( MsgLin: 1: StrLen );

        If  FmtBeg = *On;
          PxPrcLen = %Len( %Trim( MsgLin )) + 3 + LeadBlk;
        Else;
          PxPrcLen = %Len( %Trim( MsgLin )) + 1 + LeadBlk;
        EndIf;

        Return  MsgLin;

      /End-Free

     P FmtMsgLin       E
     **-- Find format instruction:
     P FndFmtIns       B
     D                 Pi             5u 0
     D  PxMsgLin                     82a   Const  Varying
     D  PxOffSet                      5u 0 Const  Options( *NoPass )

     **-- Local variables:
     D FmtPosN         s              5u 0
     D FmtPosP         s              5u 0
     D FmtPosB         s              5u 0
     D OffSet          s              5u 0

      /Free

        If  %Parms = 2;
          OffSet = PxOffSet;
        Else;
          OffSet = 1;
        EndIf;

        FmtPosN = %Scan( '&N': PxMsgLin: OffSet );
        FmtPosP = %Scan( '&P': PxMsgLin: OffSet );
        FmtPosB = %Scan( '&B': PxMsgLin: OffSet );

        If  FmtPosN = *Zero;
          FmtPosN = *HiVal;
        EndIf;
        If  FmtPosP = *Zero;
          FmtPosP = *HiVal;
        EndIf;
        If  FmtPosB = *Zero;
          FmtPosB = *HiVal;
        EndIf;

        Select;
        When FmtPosN < FmtPosP  And
             FmtPosN < FmtPosB;
          Return  FmtPosN;

        When FmtPosP < FmtPosN  And
             FmtPosP < FmtPosB;
          Return  FmtPosP;

        When FmtPosB < FmtPosN  And
             FmtPosB < FmtPosP;
          Return  FmtPosB;
        EndSl;

        Return  *Zero;

      /End-Free

     P FndFmtIns       E
     **-- Get inden positions:
     P GetIndPos       B
     D                 Pi             5u 0
     D  PxFmtIns                      2a   Const
     D  PxIndNxt                      5u 0

      /Free

        Select;
        When  PxFmtIns = '&N';
          PxIndNxt = 3;
          Return  1;

        When  PxFmtIns = '&P';
          PxIndNxt = 3;
          Return  5;

        When  PxFmtIns = '&B';
          PxIndNxt = 5;
          Return  3;

        Other;
          PxIndNxt = 0;
          Return  0;
        EndSl;

      /End-Free

     P GetIndPos       E
     **-- Scan reverse:
     P ScanR           B
     D                 Pi             5u 0
     D  PxArg                       128a   Const  Varying
     D  PxString                   4096a   Const  Varying
     D  PxOfs                         5u 0 Const  Options( *NoPass )
     **
     D Pos             s              5u 0
     D Ofs             s              5u 0

      /Free

        If  %Parms = 3;
          Ofs = PxOfs - %Len( PxArg ) + 1;
        Else;
          Ofs = %Len( PxString ) - %Len( PxArg ) + 1;
        EndIf;

        If  Ofs > %Len( PxString );
          Pos = %Len( PxString ) + 1;
        Else;

          For  Pos = Ofs  DownTo  1;

            If  %SubSt( PxString: Pos: %Len( PxArg )) = PxArg;
              Leave;
            EndIf;
          EndFor;
        EndIf;

        Return  Pos;

      /End-Free

     P ScanR           E
     ** As400ObjFound - Attempts to locate an AS/400 object
     P As400ObjFound   B

     D As400ObjFound   PI              N
     D  QlObjName                    20    Value
     D  ObjType                      10    Value

      * Local variables and prototypes

     D RtvObjDesc      PR                  ExtPgm( 'QUSROBJD' )
     D  RcvrVar                       8
     D  LenRcvrVar                   10I 0 Const
     D  FmtName                       8    Const
     D  QlObjName                    20    Const
     D  ObjType                      10    Const
     D  ApiErrInf                          Like( ApiError )

     D Rcvr            S              8


      * Invoke the QUSROBJD API to attempt to locate the object
     C                   CallP     RtvObjDesc( Rcvr:
     C                                         %Size( Rcvr ):
     C                                         'OBJD0100':
     C                                         QlObjName:
     C                                         ObjType:
     C                                         ApiError )

      * If the API returns any error at all, I assume we were unable to
      * locate the object.
     C                   If        AeBytAvl   > *Zero
     C                   CallP     SndEscMsg( AeExcpId
     C                                : 'QCPFMSG'
     C                                : %Subst( AeExcpDta: 1: AeBytAvl- 16 )
     C                                       )
     C                   Return    *Off
     C                   Else
     C                   Return    *On
     C                   EndIf

     P As400ObjFound   E
     **-- Send escape message:  ----------------------------------------------**
     P SndEscMsg       B
     D                 Pi            10i 0
     D  PxMsgId                       7a   Const
     D  PxMsgF                       10a   Const
     D  PxMsgDta                    512a   Const  Varying
     **
     D MsgKey          s              4a
     D MsgFQual        s             20a

     C                   If        %SubSt(PxMsgId: 1: 3) = 'GUI'
     C                   eval      %SubSt(MsgFQual : 1: 10) = 'QGUIMSG'
     C                   Else
     C                   eval      %SubSt(MsgFQual : 1: 10) = PxMsgF
     C                   EndIf
     C                   eval      %SubSt(MsgFQual :11: 10) = '*LIBL'

     C                   Callp     SndPgmMsg( PxMsgId
     C                                       : MsgFQual
     C                                       : PxMsgDta
     C                                       : %Len( PxMsgDta )
     C                                       : '*ESCAPE'
     C                                       : '*PGMBDY'
     C                                       : 1
     C                                       : MsgKey
     C                                       : ApiError
     C                                      )

     C                   If        AeBytAvl   > *Zero
     C                   Return    -1
     C
     C                   Else
     C                   Return    0
     C                   EndIf
     P SndEscMsg       E



File  : QCMDSRC

Member: CHKJOBMSGW

Usage : CrtCmd      Cmd( CHKJOBMSGW )    
                    Pgm( CHKJOBMSGW  ) 
                    SrcFile( YourSourceFile )

/*  ===============================================================  */
/*  = Command....... ChkJobMsgw                                   =  */
/*  = CPP........... ChkJobMsgw RPGLE                             =  */
/*  = Description... Check job message waiting and send           =  */
/*  =                notification to msgq or detail info to mail  =  */
/*  =                or both                                      =  */
/*  =                                                             =  */
/*  = CrtCmd      Cmd( ChkJobMsgw )                               =  */
/*  =             Pgm( ChkJobMsgw )                               =  */
/*  =             SrcFile( YourSourceFile )                       =  */
/*  ===============================================================  */
/*  = Date  : 2015/06/05                                          =  */
/*  = Author: Vengoal Chang                                       =  */
/*  ===============================================================  */
/*  = Usage:                                                      =  */
/*  =   Notification send to MsgQ QSYSOPR :                       =  */
/*  =   SBMJOB CMD(CHKJOBMSGW WAKEUP(600))                        =  */
/*  =          JOB(CHKJOBMSGW)                                    =  */
/*  =          JOBQ(QSYSNOMAX)                                    =  */
/*  =                                                             =  */
/*  =   Notification send to Mail with attachement by SNDSMTPEMM  =  */
/*  =   SBMJOB CMD(CHKJOBMSGW WAKEUP(600)                         =  */
/*  =                         MAIL(*YES)                          =  */
/*  =                         MSGQ(*NO )                          =  */
/*  =                         TOMAIL('user@domain')               =  */
/*  =                         CLTCCSID(819)                       =  */
/*  =             )                                               =  */
/*  =          JOB(CHKJOBMSGW)                                    =  */
/*  =          JOBQ(QSYSNOMAX)                                    =  */
/*  =                                                             =  */
/*  ===============================================================  */
             Cmd        Prompt('Check Job Message Wait')

             Parm       WAKEUP        *Dec     (5 0)                 +
                        Dft(300)                                     +
                        Prompt('Wakeup interval for the batch')

             Parm       MAIL          *Char      4                   +
                        Dft(*NO)                                     +
                        Values(*YES *NO)                             +
                        Rstd(*YES)                                   +
                        Prompt('Send to mail')

             Parm       MSGQ          *Char      4                   +
                        Dft(*YES)                                    +
                        Values(*YES *NO)                             +
                        Rstd(*YES)                                   +
                        Prompt('Send to MsgQ')

             Parm       TOMAIL        *Char     32                   +
                        PmtCtl(IFMAIL)                               +
                        Prompt('Notification send to email')

             Parm       CLTCCSID      *Dec     (5 0)                 +
                        PmtCtl(IFMAIL)                               +
                        Dft(950)                                     +
                        Prompt('Client ccsid for mail used')

             Parm       TOMSGQ                                       +
                        Type( Qual2)                                 +
                        PmtCtl(IFMSGQ)                               +
                        Prompt('Notification send to MsgQ')


 QUAL2:      Qual       Type(*NAME)                                  +
                        Dft(QSYSOPR)                                 +
                        Expr(*YES)
             Qual       Type(*NAME)                                  +
                        Dft(*LIBL)                                   +
                        SpcVal((*LIBL) (*CURLIB))                    +
                        Expr(*YES)                                   +
                        Prompt('Library')

 IFMAIL:     PmtCtl     Ctl(MAIL)  Cond((*EQ *YES))
 IFMSGQ:     PmtCtl     Ctl(MSGQ)  Cond((*EQ *YES))

             Dep        Ctl(&MAIL *EQ *YES)                          +
                        Parm((&TOMAIL *NE ' '))                      +
                        NbrTrue(*EQ 1)

             Dep        Ctl(&MAIL *EQ *NO)                           +
                        Parm((&MSGQ *NE *NO))                        +
                        NbrTrue(*EQ 1)


						



參照: Open List of Jobs (QGYOLJOB) API





沒有留言: