2023-12-22 Get top cpu usage percentage job (TOPCPUPCT)
File : QRPGLESRC
Member: TOPCPUPCT
Type : RPGLE
**
** Program . . : TopCpuPct
** Description : Finds CPU Top and notifies caller
** Author . . : Vengoal Chang
** Published . : AS400 ePaper
** Date . . . : November 21, 2023
**
**
** 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 processor unit
** time percentage in descending
** order - listing the jobs having
** the highest CPU usage first.
**
** The CPU processor time is measured
** for an interval of 10 seconds in
** this example.
**
** The QGYOLJOB API is found in the
** QGY library as are all other open
** list APIs.
**
** 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.
**
** 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 act jobs processor time limit percentage is retrieved
**
** 2. The list jobs API input parameters are initialized
**
** 3. The open list of jobs API is called to reset the job
** statistics.
**
** 4. Program is suspended for some seconds
**
** 5. The open list of jobs API is called to list the interactive
** jobs on the system returning the most CPU intensive jobs
** for the elapsed period first.
**
** 6. For each top cpu percent job a message is sent to the
** message queue.
**
** 7. The job list resources are cleaned up.
**
** 8. The program will loop 1 to 7, until manual job.
**
** Programmer's notes:
**
** As mentioned above library QGY must be in the job library list
** to succesfully run this program.
**
** To retrieve another job's call stack *JOBCTL special authority is
** required.
**
**
** Compile options:
**
** CrtRpgMod Module( TOPCPUPCT ) DbgView( *LIST )
**
** CrtPgm Pgm( TOPCPUPCT )
** Module( TOPCPUPCT )
**
** Usage sample:
** Get top first CPU% job per 60 secs with following:
** SBMJOB
** CMD(TOPCPUPCT TOPCOUNT(001) INTERVAL(00060)
** TOMSGQ(*SYSOPR))
** Job(TOPPCTPCT)
**
** Get top 5 CPU% job per 60 secs with following:
** SBMJOB
** CMD(TOPCPUPCT TOPCOUNT(005) INTERVAL(00060)
** TOMSGQ(*SYSOPR))
** Job(TOPPCTPCT)
**
**-- Control spec: -----------------------------------------------------**
H Option( *SrcStmt ) DecEdit( *JobRun ) BndDir( 'QC2LE' )
H DftActGrp(*NO)
**-- 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( 3 )
**-- Job information:
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 JbActSts 4a
D JbJobTyp 1a
D JbJobSubTyp 1a
D JbDtaLen 10i 0
D 4a
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( '*' )
D 1a
D SiOfsPriSts 10i 0 Inz( 60 )
D SiNbrPriSts 10i 0 Inz( 0 )
D SiOfsActSts 10i 0 Inz( 70 )
D SiNbrActSts 10i 0 Inz( 0 )
D SiOfsJbqSts 10i 0 Inz( 78 )
D SiNbrJbqSts 10i 0 Inz( 0 )
D SiOfsJbqNam 10i 0 Inz( 88 )
D SiNbrJbqNam 10i 0 Inz( 0 )
**
D SiPriSts 10a Dim( 1 )
D SiActSts 4a Dim( 2 )
D SiJbqSts 10a Dim( 1 )
D SiJbqNam 20a Dim( 1 )
**-- Job information key fields:
D JbKeyDta Ds
D JbPrcUniTim 20u 0
D JbPrcUniPct 9b 1
D JbPrcUniTimE 20u 0
**-- General return data:
D JlGenDta Ds
D GdBytRtn 10i 0
D GdBytAvl 10i 0
D GdElpTim 20u 0
D 16a
**-- MatRmd parameters: ------------------------------------------------**
D MatRscMgDt Ds
D RdBytPrv 10i 0 Inz( %Size( MatRscMgDt ))
D RdBytAvl 10i 0
D RdTimDay 8a
D RdData
D RdPrcTimIpl 20u 0 Overlay( RdData: 1 )
D RdPrcTimScWl 20u 0 Overlay( RdData: *Next )
D RdPrcTimDb 20u 0 Overlay( RdData: *Next )
D RdPrcTimDbTh 5u 0 Overlay( RdData: *Next )
D RdPrcTimDbLm 5u 0 Overlay( RdData: *Next )
D RdRsv1 10u 0 Inz( x'00' )
D Overlay( RdData: *Next )
D RdPrcTimInt 20u 0 Overlay( RdData: *Next )
D RdPrcTimIntT 4b 1 Overlay( RdData: *Next )
D RdPrcTimIntL 4b 1 Overlay( RdData: *Next )
D RdRsv2 10u 0 Inz( x'00' )
D Overlay( RdData: *Next )
**
D MatCtlDta Ds
D CdSltOpt 1a Inz( x'01' )
D CdRsv 7a Inz( *Allx'00' )
**-- Global variables: -------------------------------------------------**
D Ix s 5i 0
D Count s 5i 0
D Interval s 10u 0
D TopCount s 3S 0
D PgmNam s 10a
D MsgDta s 256a Varying
D MsgKey s 4a
D SysTime s z inz(*sys)
**-- 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
**-- Materialize resource management data: -----------------------------**
D MatRmd Pr ExtProc( '_MATRMD' )
D Rcv Like( MatRscMgDt )
D Ctl Like( MatCtlDta )
**
**-- Mainline: ---------------------------------------------------------**
**
C *Entry Plist
C Parm TopCount_p 3
C Parm Interval_p 5
C Parm ToMsgQ 10
**
C Eval TopCount = %Int(TopCount_p)
C Eval Interval = %Int(Interval_p)
C Select
C When ToMsgQ = '*SYSOPR'
C Eval ToMsgQ = 'QSYSOPR'
C When ToMsgQ = '*CURUSR'
C Eval ToMsgQ = PsCurUsr
C EndSl
**
**-- Job information return fields:
C Eval JlKeyFld(1) = 312
C Eval JlKeyFld(2) = 314
C Eval JlKeyFld(3) = 315
**
**-- Sort field specification:
C Eval SiNbrKeys = 1
C Eval SiKeyFldOfs(1) = 49
C Eval SiKeyFldLen(1) = 4
C Eval SiKeyFldTyp(1) = 0
C Eval SiSrtOrd(1) = '2'
C Eval SiRsv(1) = x'00'
**
**-- Initialize job CPU measurement:
**-- NOTE: Statistics only reset if return records are requested
**
C DoW 1 = 1
C CallP LstJobs( JlJobInf
C : %Size( JlJobInf )
C : 'OLJB0300'
C : JlKeyInf
C : %Size( JlKeyInf )
C : JlLstInf
C : 1
C : JlSrtInf
C : JlSltInf
C : %Size( JlSltInf )
C : JlNbrFldRtn
C : JlKeyFld
C : ApiError
C : 'OLJS0100'
C : JOB_RESET_STAT
C : JlGenDta
C : %Size( JlGenDta )
C )
**
**-- Wait 10 seconds:
C CallP sleep( Interval )
**
**-- Retrieve job list:
C CallP LstJobs( JlJobInf
C : %Size( JlJobInf )
C : 'OLJB0300'
C : JlKeyInf
C : %Size( JlKeyInf )
C : JlLstInf
C : 1
C : JlSrtInf
C : JlSltInf
C : %Size( JlSltInf )
C : JlNbrFldRtn
C : JlKeyFld
C : ApiError
C : 'OLJS0100'
C : JOB_KEEP_STAT
C : JlGenDta
C : %Size( JlGenDta )
C )
**
C If AeBytAvl = *Zero
**
C Eval Count = 0
C DoW LiLstSts <> '2' Or
C LiRcdNbrTot > JlRtnRcdNbr
**
C ExSr GetCpuDta
C ExSr ChkCpuPct
**
C* ExSr SndCmpMsg
**
C If Count >= TopCount
C Leave
C EndIf
**
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 )
**
C EndIf
**
C EndDo
**
C Eval *InLr = *On
**
C Return
**
**-- Get CPU data: -----------------------------------------------------**
C GetCpuDta BegSr
**
C Clear JbKeyDta
**
C For Ix = 1 To KiFldNbrRtn
**
C Select
C When KiKeyFld(Ix) = 312
C CallP memcpy( %Addr( JbPrcUniTim )
C : %Addr( JlJobInf ) +
C KiDtaOfs(Ix)
C : KiDtaLen(Ix)
C )
**
C When KiKeyFld(Ix) = 314
C CallP memcpy( %Addr( JbPrcUniPct )
C : %Addr( JlJobInf ) +
C KiDtaOfs(Ix)
C : KiDtaLen(Ix)
C )
**
C When KiKeyFld(Ix) = 315
C CallP memcpy( %Addr( JbPrcUniTimE )
C : %Addr( JlJobInf ) +
C KiDtaOfs(Ix)
C : KiDtaLen(Ix)
C )
C EndSl
C EndFor
**
C EndSr
**-- Check CPU percent: ------------------------------------------------**
C ChkCpuPct BegSr
**
C Eval Count = Count + 1
C Eval PgmNam = GetTopStkE( JbJobId )
**
C Eval SysTime = %Timestamp()
C Eval MsgDta =
C '{ "CPUPCTMSG": { ' +
C '"QDATETIME" : "' +
C %Char(%Timestamp():*ISO) + '", ' +
C '"JobNam" : "' +
C %Trim(JbJobUsd) + '", ' +
C '"JobUsr" : "' +
C %Trim(JbUsrUsd) + '", ' +
C '"JobNbr" : "' +
C %Trim(JbNbrUsd) + '", ' +
C '"CpuPct" : "' +
C %Char( JbPrcUniPct ) + '", ' +
C '"PgmNam" : "' +
C %Trim( PgmNam ) + '" ' +
C '} }'
**
C CallP(e) SndMsg( *Blanks
C : *Blanks
C : MsgDta
C : %Len( MsgDta )
C : '*INFO'
C : ToMsgQ + '*LIBL'
C : 1
C : *Blanks
C : MsgKey
C : 0
C )
**
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 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
File : QCMDSRC
Member: TOPCPUPCT
Type : CMD
/* =============================================================== */
/* = Command....... TopCpuPct = */
/* = CPP........... TopCpuPct RPGLE = */
/* = Description... Send WRKACTJOB CPUPCT top to user = */
/* = = */
/* = = */
/* = CrtCmd Cmd( TopCpuPct ) = */
/* = Pgm( TopCpuPct ) = */
/* = SrcFile( YourSourceFile ) = */
/* =============================================================== */
/* = Date : 2023/11/21 = */
/* = Author: Vengoal Chang = */
/* =============================================================== */
CMD PROMPT('Top Cpu Percent Job')
PARM KWD(TOPCOUNT) TYPE(*CHAR) LEN(3) +
RANGE('001' '999') +
FULL(*YES) +
PROMPT('TOP CPU JOB COUNT')
PARM KWD(INTERVAL) TYPE(*CHAR) LEN(5) +
RANGE('00001' '99999') +
FULL(*YES) +
PROMPT('Interval second')
PARM KWD(TOMSGQ) TYPE(*CHAR) LEN(10) +
DFT(*SYSOPR) +
SPCVAL((*SYSOPR) (*CURUSR)) +
PROMPT('Message To MsgQ')
Program to capture CPU usage over time (with SQL)
星期五, 12月 22, 2023
2023-12-22 Get top cpu usage percentage job (TOPCPUPCT)
星期四, 12月 07, 2023
MessageQ Break-Handling Programs
The section from the V4R3 CL Programmers Guide on break handlers.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
8.4 Break-Handling Programs
A break-handling program is one that is automatically called when a message
arrives at a message queue that is in *BREAK mode. Both the name
of the program and the break delivery name must be specified on the same
Change Message Queue (CHGMSGQ) command. Although the program
is specified on the CHGMSGQ command, it is one or more procedures within the
program that processes the message. A procedure within this
program must run a Receive Message (RCVMSG) command to receive the message.
To receive and handle the message, the user-defined
program called to handle messages for break delivery is passed parameters
(more specifically, the first procedure to run within the program is
passed these parameters). The parameters identify the message queue and the
message reference key (MRK) of the message causing the
break. See the Break Handling exit program in the System API Reference,
SC41-5801 book, for a list of the parameters. If the break-handling
program is called, it interrupts the job in which the message occurred and
runs. When the break-handling program ends, the original program
resumes processing.
The following program (PGMA), which consists of only this one procedure, is
an example of a break-handling program.
PGM PARM(&MSGQ &MSGLIB &MRK)
DCL VAR(&MSGQ) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&MRK) TYPE(*CHAR) LEN(4)
DCL VAR(&MSG) TYPE(*CHAR) LEN(75)
RCVMSG MSGQ(&MSGLIB/&MSGQ) MSGKEY(&MRK) +
MSG(&MSG)
.
.
.
ENDPGM
After the break-handling program is created, running the following command
connects it to the QSYSMSG message queue.
CHGMSGQ MSGQ(QSYS/QSYSMSG) DLVRY(*BREAK) PGM(PGMA)
Notes:
1. When messages are handled, they should be removed from the message
queue. When a message queue is put in break mode, any message
on the queue will cause the break-handling program to get called.
2. The procedure or program receiving the message should not be coded with
a wait-time other than zero to receive a message. You can specify
a value other than zero for the wait parameter with the Receive Message
(RCVMSG) command. The message arrival event cannot be handled
by the system while the job is running a break-handling event.
An example of a break-handling program is to have the program send a
message, which is normally sent to the QSYSOPR queue, to another
queue in place of or in addition to QSYSOPR.
The following is an example of a user-defined program (again with only one
procedure) to handle break messages. The display station user does
not need to respond to the messages CPA5243 (Press Ready, Start, or
Start-Stop on device &1) and CPA5316 (Verify alignment on device &3)
when this program is used.
BRKPGM: PGM (&MSGQ &MSGQLIB &MSGMRK)
DCL &MSGQ TYPE(*CHAR) LEN(10)
DCL &MSGQLIB TYPE(*CHAR) LEN(10)
DCL &MSGMRK TYPE(*CHAR) LEN(4)
DCL &MSGID TYPE(*CHAR) LEN(7)
RCVMSG MSGQ(&MSGQLIB/&MSGQ) MSGKEY(&MSGMRK) +
MSGID(&MSGID) RMV(*NO)
/* Ignore message CPA5243 */
IF (&MSGID *EQ 'CPA5243') GOTO ENDBRKPGM
/* Reply to forms alignment message */
IF (&MSGID *EQ 'CPA5316') +
DO
SNDRPY MSGKEY(&MSGMRK) MSGQ(&MSGQLIB/&MSGQ) RPY(I)
ENDDO
/* Other messages require user intervention */
ELSE CMD(DSPMSG MSGQ(&MSGQLIB/&MSGQ))
ENDBRKPGM: ENDPGM
Attention:
In the above example of a break-handling program, if a CPA5316 message
should arrive at the queue while the DSPMSG command is running, the
DSPMSG display shows the original message that caused the break and the
CPA5316 message. The DSPMSG display waits for the operator to
reply to the CPA5316 message before proceeding.
Note: This program cannot open a display file if the interrupted program is
waiting for input data from the display.
You can use the system reply list to indicate the system will issue a reply
to predefined inquiry messages. The display station user, therefore,
does not need to reply. For more information, see "Using the System Reply
List" in topic 8.6.
A procedure within a user break-handling program may need a Suspend and
Restore procedure to ensure the display is suspended and restored
while the message handling function is being performed. The Suspend and
Restore procedure is necessary only if the following conditions exist:
A procedure in the break-program displays other menus or screens
The break-program calls other programs which may display other menus or
screens.
The following example clarifies the user procedure and display file needed
to suspend and restore the display:
Note: RSTDSP(*YES) must be specified to create the display file.
A R SAVFMT OVERLAY KEEP
A*
A R DUMMY OVERLAY
A KEEP
A ASSUME
A DUMMYR 1A 1 2DSPATR(ND)
PGM PARM(&MSGQ &MSGLIB &MRK)
DCL VAR(&MSGQ) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&MRK) TYPE(*DEC) LEN(4)
DCLF FILE(UDDS/BRKPGMFM)
SNDF RCDFMT(SAVFMT)
CALL PGM(User's Break Program)
SNDF RCDFMT(SAVFMT)
ENDPGM
Break message handling program
To compile, use the following command:
CRTCLPGM PGM(xxx/MSG2LIN24) SRCFILE(xxx/QCLSRC)
Key the program into source physical file QCLSRC in one of your libraries (represented by xxx),
then compile the program by executing the CRTCLPGM as indicated. Now run the following command:
CHGMSGQ MSGQ(…) DLVRY(*BREAK) PGM(xxx/MSG2LIN24)
訂閱：
文章 (Atom)