|
midrange.com
The attachments to this posting are the same at the text included. If you
can't get the attachments, you should be able to use the text in this message to
generate the source code.
README.TXT ****************************************************************
This program monitors QSYSOPR and will send a message
to a pager if an unanswered message is in the queue for
longer that 30 minutes. We run this program every 10
minutes, a message about unanswered messages will be
sent to specified users each time the program is run.
We use ROBOT Alert for paging from the AS/400.
The main program is called $MSG. Programs $MSG2 and
$MSG3 also need to be compiled.
**Note** - These programs require the use of a program
from Help Systems called RBT835. If you do not have
the program on your system, you will need to contact
Help Systems @ 1-800-328-1000 or write your own program
to provide the same function.
The source code is provided "as is" with no implied
warranties. Use at your own risk. Hope the code works
for you as good as it works for us.
Pattonville School District
Kirk R. Yates
11097 St Charles Rock Road
St Ann, MO 63074-1509
(314) 213-8045 voice
(314) 213-8650 fax
yatesk@pattonville.k12.mo.us
$MSG ********************************************************************
/*----------------------------------------------------------------------------*/
/* This program will scan the QSYSOPR MSGQ for any unanswered INQUIRY */
/* messages, and notify the appropriate individuals. */
/* */
/* */
/* */
/*----------------------------------------------------------------------------*/
PGM
DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
DCL VAR(&CHECK) TYPE(*CHAR) LEN(7)
DCL VAR(&RTNTYPE) TYPE(*CHAR) LEN(2)
DCL VAR(&KEYVAR) TYPE(*CHAR) LEN(4)
DCL VAR(&SENDER) TYPE(*CHAR) LEN(80)
DCL VAR(&MSGIN) TYPE(*CHAR) LEN(132)
DCL VAR(&MSGOUT) TYPE(*CHAR) LEN(256)
DCL VAR(&DATE) TYPE(*CHAR) LEN(6)
DCL VAR(&TIME) TYPE(*CHAR) LEN(6)
DCL VAR(&DATE1) TYPE(*DEC) LEN(6 0)
DCL VAR(&TIME1) TYPE(*DEC) LEN(6 0)
DCL VAR(&DATE2) TYPE(*DEC) LEN(6 0)
DCL VAR(&TIME2) TYPE(*DEC) LEN(6 0)
DCL VAR(&TIMDIF) TYPE(*DEC) LEN(7 0)
ADDLIBLE LIB(ROBOTLIB)
MONMSG MSGID(CPF0000)
ADDLIBLE LIB(RBTSYSLIB)
MONMSG MSGID(CPF0000)
CALL PGM(QGPL/$MSG2)
/* Read message queue QSYSOPR for inquiry type messages only */
MSG: RCVMSG MSGQ(QSYSOPR) MSGTYPE(*INQ) RMV(*NO) +
KEYVAR(&KEYVAR) MSG(&MSGIN) MSGID(&MSGID) +
SENDER(&SENDER) RTNTYPE(&RTNTYPE)
MONMSG MSGID(CPF2451) EXEC(GOTO CMDLBL(ENDPGM))
/* If no more messages to be read, goto end of program */
IF COND(&MSGID = ' ') THEN(GOTO CMDLBL(ENDPGM))
/* Check to see if reply has been sent for this message */
RCVMSG MSGQ(QSYSOPR) MSGTYPE(*RPY) MSGKEY(&KEYVAR) +
RMV(*NO) MSGID(&CHECK)
IF COND(&CHECK ª= ' ') THEN(GOTO CMDLBL(MSG))
/* If message requires response, process this message */
IF COND(&RTNTYPE = '05') THEN(DO)
RTVSYSVAL SYSVAL(QTIME) RTNVAR(&TIME)
RTVSYSVAL SYSVAL(QDATE) RTNVAR(&DATE)
CHGVAR VAR(&DATE2) VALUE(&DATE)
CHGVAR VAR(&TIME2) VALUE(&TIME)
CHGVAR VAR(&DATE) VALUE(%SST(&SENDER 46 2) || +
%SST(&SENDER 48 2) || %SST(&SENDER 44 2))
CHGVAR VAR(&TIME) VALUE(%SST(&SENDER 50 6))
CHGVAR VAR(&DATE1) VALUE(&DATE)
CHGVAR VAR(&TIME1) VALUE(&TIME)
CALL PGM(RBT835) PARM(&DATE1 &TIME1 &DATE2 &TIME2 +
&TIMDIF)
/* If message has been in queue less than 10 minutes, check for another msg */
IF COND(&TIMDIF < 10) THEN(GOTO CMDLBL(MSG))
/* Build message to be transmitted to appropriate receiver */
CHGVAR VAR(&MSGOUT) VALUE('Msgq QSYSOPR is waiting +
for a reply to message: "' || &MSGIN +
*TCAT '", sent from Job:' || %SST(&SENDER +
1 10) |> 'User:' || %SST(&SENDER 11 10) +
|> 'on' |> %SST(&SENDER 46 2) || '/' || +
%SST(&SENDER 48 2) || '/' || %SST(&SENDER +
44 2) |> 'at' |> %SST(&SENDER 50 2) || +
':' || %SST(&SENDER 52 2) || ':' || +
%SST(&SENDER 54 2))
/* */
/* If message has been in queue longer than 10 minutes, send messages out */
IF COND(&TIMDIF > 10) THEN(DO)
SNDMSG MSG(&MSGOUT) TOUSR(YATESK)
SNDMSG MSG(&MSGOUT) TOUSR(KEPPLERJ)
SNDMSG MSG(&MSGOUT) TOUSR(HOWARDK)
IF COND(&TIME < '070000') +
THEN(SNDMSG MSG(&MSGOUT) TOUSR(GILBERTN))
ENDDO
/* If message has been in queue more than 30 minutes, notify pager system */
IF COND(&TIMDIF > 30) THEN(DO)
RBTALRLIB/RBASNDMSG MSG(&MSGOUT) TOPG(@DP)
ENDDO
/* */
GOTO CMDLBL(MSG)
ENDDO /* &RTNTYPE = "05" */
/* Reset msgq to allow furture reads of unanswered INQ messages */
ENDPGM: CHGMSGQ MSGQ(QSYSOPR) RESET(*YES)
MONMSG MSGID(CPF0000)
CALL PGM(QGPL/$MSG3)
ENDPGM
$MSG2 *******************************************************************
PGM
DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
DCL VAR(&RTNTYPE) TYPE(*CHAR) LEN(2)
DCL VAR(&KEYVAR) TYPE(*CHAR) LEN(4)
DCL VAR(&SENDER) TYPE(*CHAR) LEN(80)
DCL VAR(&MSGIN) TYPE(*CHAR) LEN(132)
/* READ ALL QSYSOPR INQUIRY TYPE MESSAGES, AND RESET */
LOOP: RCVMSG MSGQ(QSYSOPR) MSGTYPE(*INQ) RMV(*NO) +
KEYVAR(&KEYVAR) MSG(&MSGIN) MSGID(&MSGID) +
SENDER(&SENDER) RTNTYPE(&RTNTYPE)
MONMSG MSGID(CPF2451) EXEC(GOTO CMDLBL(RESET))
IF COND(&MSGID = ' ') THEN(GOTO +
CMDLBL(ENDPGM))
GOTO CMDLBL(LOOP)
RESET: CHGMSGQ MSGQ(QSYSOPR) RESET(*YES)
MONMSG MSGID(CPF0000)
RETURN
ENDPGM: CHGMSGQ MSGQ(QSYSOPR) RESET(*YES)
MONMSG MSGID(CPF0000)
RETURN
ENDPGM
$MSG3 *******************************************************************
PGM
DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
DCL VAR(&RTNTYPE) TYPE(*CHAR) LEN(2)
DCL VAR(&KEYVAR) TYPE(*CHAR) LEN(4)
DCL VAR(&SENDER) TYPE(*CHAR) LEN(80)
DCL VAR(&MSGIN) TYPE(*CHAR) LEN(132)
DCL VAR(&SEV) TYPE(*DEC) LEN(2 0)
DCL VAR(&DATE) TYPE(*CHAR) LEN(6)
DCL VAR(&TIME) TYPE(*CHAR) LEN(6)
DCL VAR(&DATE1) TYPE(*DEC) LEN(6 0)
DCL VAR(&TIME1) TYPE(*DEC) LEN(6 0)
DCL VAR(&DATE2) TYPE(*DEC) LEN(6 0)
DCL VAR(&TIME2) TYPE(*DEC) LEN(6 0)
DCL VAR(&TIMDIF) TYPE(*DEC) LEN(7 0)
DCL VAR(&MSGOUT) TYPE(*CHAR) LEN(256)
ADDLIBLE LIB(ROBOTLIB)
MONMSG MSGID(CPF0000)
ADDLIBLE LIB(RBTSYSLIB)
MONMSG MSGID(CPF0000)
/* READ ALL QSYSOPR INQUIRY TYPE MESSAGES, AND RESET */
LOOP: RCVMSG MSGQ(QSYSOPR) MSGTYPE(*INFO) RMV(*NO) +
KEYVAR(&KEYVAR) MSG(&MSGIN) MSGID(&MSGID) +
SEV(&SEV) SENDER(&SENDER) RTNTYPE(&RTNTYPE)
MONMSG MSGID(CPF2451) EXEC(GOTO CMDLBL(RESET))
IF COND(&MSGID = ' ') THEN(GOTO +
CMDLBL(ENDPGM))
IF COND(&SEV *EQ 99) THEN(DO)
RTVSYSVAL SYSVAL(QTIME) RTNVAR(&TIME)
RTVSYSVAL SYSVAL(QDATE) RTNVAR(&DATE)
CHGVAR VAR(&DATE2) VALUE(&DATE)
CHGVAR VAR(&TIME2) VALUE(&TIME)
CHGVAR VAR(&DATE) VALUE(%SST(&SENDER 46 2) || +
%SST(&SENDER 48 2) || %SST(&SENDER 44 2))
CHGVAR VAR(&TIME) VALUE(%SST(&SENDER 50 6))
CHGVAR VAR(&DATE1) VALUE(&DATE)
CHGVAR VAR(&TIME1) VALUE(&TIME)
CALL PGM(RBT835) PARM(&DATE1 &TIME1 &DATE2 &TIME2 +
&TIMDIF)
CHGVAR VAR(&MSGOUT) VALUE('Msgq QSYSOPR has a +
severity level 99 message: "' || &MSGIN +
*TCAT '", sent from Job:' || %SST(&SENDER +
1 10) |> 'User:' || %SST(&SENDER 11 10) +
|> 'on' |> %SST(&SENDER 46 2) || '/' || +
%SST(&SENDER 48 2) || '/' || %SST(&SENDER +
44 2) |> 'at' |> %SST(&SENDER 50 2) || +
':' || %SST(&SENDER 52 2) || ':' || +
%SST(&SENDER 54 2))
SNDMSG MSG(&MSGOUT) TOUSR(YATESK)
SNDMSG MSG(&MSGOUT) TOUSR(KEPPLERJ)
SNDMSG MSG(&MSGOUT) TOUSR(HOWARDK)
IF COND(&TIME < '070000') +
THEN(SNDMSG MSG(&MSGOUT) TOUSR(GILBERTN))
/* If message has been in queue more than 30 minutes, notify pager system */
IF COND(&TIMDIF > 30) THEN(DO)
RBASNDMSG MSG(&MSGOUT) TOPG(@DP)
ENDDO
ENDDO
GOTO CMDLBL(LOOP)
RESET: CHGMSGQ MSGQ(QSYSOPR) RESET(*YES)
MONMSG MSGID(CPF0000)
RETURN
ENDPGM: CHGMSGQ MSGQ(QSYSOPR) RESET(*YES)
MONMSG MSGID(CPF0000)
RETURN
ENDPGM
This program monitors QSYSOPR and will send a message to a pager if an unanswered message is in the queue for longer that 30 minutes. We run this program every 10 minutes, a message about unanswered messages will be sent to specified users each time the program is run. We use ROBOT Alert for paging from the AS/400. The main program is called $MSG. Programs $MSG2 and $MSG3 also need to be compiled. **Note** - These programs require the use of a program from Help Systems called RBT835. If you do not have the program on your system, you will need to contact Help Systems @ 1-800-328-1000 or write your own program to provide the same function. The source code is provided "as is" with no implied warranties. Use at your own risk. Hope the code works for you as good as it works for us. Pattonville School District Kirk R. Yates 11097 St Charles Rock Road St Ann, MO 63074-1509 (314) 213-8045 voice (314) 213-8650 fax yatesk@pattonville.k12.mo.us
/*----------------------------------------------------------------------------*/
/* This program will scan the QSYSOPR MSGQ for any unanswered INQUIRY */
/* messages, and notify the appropriate individuals. */
/* */
/* */
/* */
/*----------------------------------------------------------------------------*/
PGM
DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
DCL VAR(&CHECK) TYPE(*CHAR) LEN(7)
DCL VAR(&RTNTYPE) TYPE(*CHAR) LEN(2)
DCL VAR(&KEYVAR) TYPE(*CHAR) LEN(4)
DCL VAR(&SENDER) TYPE(*CHAR) LEN(80)
DCL VAR(&MSGIN) TYPE(*CHAR) LEN(132)
DCL VAR(&MSGOUT) TYPE(*CHAR) LEN(256)
DCL VAR(&DATE) TYPE(*CHAR) LEN(6)
DCL VAR(&TIME) TYPE(*CHAR) LEN(6)
DCL VAR(&DATE1) TYPE(*DEC) LEN(6 0)
DCL VAR(&TIME1) TYPE(*DEC) LEN(6 0)
DCL VAR(&DATE2) TYPE(*DEC) LEN(6 0)
DCL VAR(&TIME2) TYPE(*DEC) LEN(6 0)
DCL VAR(&TIMDIF) TYPE(*DEC) LEN(7 0)
ADDLIBLE LIB(ROBOTLIB)
MONMSG MSGID(CPF0000)
ADDLIBLE LIB(RBTSYSLIB)
MONMSG MSGID(CPF0000)
CALL PGM(QGPL/$MSG2)
/* Read message queue QSYSOPR for inquiry type messages only */
MSG: RCVMSG MSGQ(QSYSOPR) MSGTYPE(*INQ) RMV(*NO) +
KEYVAR(&KEYVAR) MSG(&MSGIN) MSGID(&MSGID) +
SENDER(&SENDER) RTNTYPE(&RTNTYPE)
MONMSG MSGID(CPF2451) EXEC(GOTO CMDLBL(ENDPGM))
/* If no more messages to be read, goto end of program */
IF COND(&MSGID = ' ') THEN(GOTO CMDLBL(ENDPGM))
/* Check to see if reply has been sent for this message */
RCVMSG MSGQ(QSYSOPR) MSGTYPE(*RPY) MSGKEY(&KEYVAR) +
RMV(*NO) MSGID(&CHECK)
IF COND(&CHECK ª= ' ') THEN(GOTO CMDLBL(MSG))
/* If message requires response, process this message */
IF COND(&RTNTYPE = '05') THEN(DO)
RTVSYSVAL SYSVAL(QTIME) RTNVAR(&TIME)
RTVSYSVAL SYSVAL(QDATE) RTNVAR(&DATE)
CHGVAR VAR(&DATE2) VALUE(&DATE)
CHGVAR VAR(&TIME2) VALUE(&TIME)
CHGVAR VAR(&DATE) VALUE(%SST(&SENDER 46 2) || +
%SST(&SENDER 48 2) || %SST(&SENDER 44 2))
CHGVAR VAR(&TIME) VALUE(%SST(&SENDER 50 6))
CHGVAR VAR(&DATE1) VALUE(&DATE)
CHGVAR VAR(&TIME1) VALUE(&TIME)
CALL PGM(RBT835) PARM(&DATE1 &TIME1 &DATE2 &TIME2 +
&TIMDIF)
/* If message has been in queue less than 10 minutes, check for another msg */
IF COND(&TIMDIF < 10) THEN(GOTO CMDLBL(MSG))
/* Build message to be transmitted to appropriate receiver */
CHGVAR VAR(&MSGOUT) VALUE('Msgq QSYSOPR is waiting +
for a reply to message: "' || &MSGIN +
*TCAT '", sent from Job:' || %SST(&SENDER +
1 10) |> 'User:' || %SST(&SENDER 11 10) +
|> 'on' |> %SST(&SENDER 46 2) || '/' || +
%SST(&SENDER 48 2) || '/' || %SST(&SENDER +
44 2) |> 'at' |> %SST(&SENDER 50 2) || +
':' || %SST(&SENDER 52 2) || ':' || +
%SST(&SENDER 54 2))
/* */
/* If message has been in queue longer than 10 minutes, send messages out */
IF COND(&TIMDIF > 10) THEN(DO)
SNDMSG MSG(&MSGOUT) TOUSR(YATESK)
SNDMSG MSG(&MSGOUT) TOUSR(KEPPLERJ)
SNDMSG MSG(&MSGOUT) TOUSR(HOWARDK)
IF COND(&TIME < '070000') +
THEN(SNDMSG MSG(&MSGOUT) TOUSR(GILBERTN))
ENDDO
/* If message has been in queue more than 30 minutes, notify pager system */
IF COND(&TIMDIF > 30) THEN(DO)
RBTALRLIB/RBASNDMSG MSG(&MSGOUT) TOPG(@DP)
ENDDO
/* */
GOTO CMDLBL(MSG)
ENDDO /* &RTNTYPE = "05" */
/* Reset msgq to allow furture reads of unanswered INQ messages */
ENDPGM: CHGMSGQ MSGQ(QSYSOPR) RESET(*YES)
MONMSG MSGID(CPF0000)
CALL PGM(QGPL/$MSG3)
ENDPGM
PGM
DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
DCL VAR(&RTNTYPE) TYPE(*CHAR) LEN(2)
DCL VAR(&KEYVAR) TYPE(*CHAR) LEN(4)
DCL VAR(&SENDER) TYPE(*CHAR) LEN(80)
DCL VAR(&MSGIN) TYPE(*CHAR) LEN(132)
/* READ ALL QSYSOPR INQUIRY TYPE MESSAGES, AND RESET */
LOOP: RCVMSG MSGQ(QSYSOPR) MSGTYPE(*INQ) RMV(*NO) +
KEYVAR(&KEYVAR) MSG(&MSGIN) MSGID(&MSGID) +
SENDER(&SENDER) RTNTYPE(&RTNTYPE)
MONMSG MSGID(CPF2451) EXEC(GOTO CMDLBL(RESET))
IF COND(&MSGID = ' ') THEN(GOTO +
CMDLBL(ENDPGM))
GOTO CMDLBL(LOOP)
RESET: CHGMSGQ MSGQ(QSYSOPR) RESET(*YES)
MONMSG MSGID(CPF0000)
RETURN
ENDPGM: CHGMSGQ MSGQ(QSYSOPR) RESET(*YES)
MONMSG MSGID(CPF0000)
RETURN
ENDPGM
PGM
DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
DCL VAR(&RTNTYPE) TYPE(*CHAR) LEN(2)
DCL VAR(&KEYVAR) TYPE(*CHAR) LEN(4)
DCL VAR(&SENDER) TYPE(*CHAR) LEN(80)
DCL VAR(&MSGIN) TYPE(*CHAR) LEN(132)
DCL VAR(&SEV) TYPE(*DEC) LEN(2 0)
DCL VAR(&DATE) TYPE(*CHAR) LEN(6)
DCL VAR(&TIME) TYPE(*CHAR) LEN(6)
DCL VAR(&DATE1) TYPE(*DEC) LEN(6 0)
DCL VAR(&TIME1) TYPE(*DEC) LEN(6 0)
DCL VAR(&DATE2) TYPE(*DEC) LEN(6 0)
DCL VAR(&TIME2) TYPE(*DEC) LEN(6 0)
DCL VAR(&TIMDIF) TYPE(*DEC) LEN(7 0)
DCL VAR(&MSGOUT) TYPE(*CHAR) LEN(256)
ADDLIBLE LIB(ROBOTLIB)
MONMSG MSGID(CPF0000)
ADDLIBLE LIB(RBTSYSLIB)
MONMSG MSGID(CPF0000)
/* READ ALL QSYSOPR INQUIRY TYPE MESSAGES, AND RESET */
LOOP: RCVMSG MSGQ(QSYSOPR) MSGTYPE(*INFO) RMV(*NO) +
KEYVAR(&KEYVAR) MSG(&MSGIN) MSGID(&MSGID) +
SEV(&SEV) SENDER(&SENDER) RTNTYPE(&RTNTYPE)
MONMSG MSGID(CPF2451) EXEC(GOTO CMDLBL(RESET))
IF COND(&MSGID = ' ') THEN(GOTO +
CMDLBL(ENDPGM))
IF COND(&SEV *EQ 99) THEN(DO)
RTVSYSVAL SYSVAL(QTIME) RTNVAR(&TIME)
RTVSYSVAL SYSVAL(QDATE) RTNVAR(&DATE)
CHGVAR VAR(&DATE2) VALUE(&DATE)
CHGVAR VAR(&TIME2) VALUE(&TIME)
CHGVAR VAR(&DATE) VALUE(%SST(&SENDER 46 2) || +
%SST(&SENDER 48 2) || %SST(&SENDER 44 2))
CHGVAR VAR(&TIME) VALUE(%SST(&SENDER 50 6))
CHGVAR VAR(&DATE1) VALUE(&DATE)
CHGVAR VAR(&TIME1) VALUE(&TIME)
CALL PGM(RBT835) PARM(&DATE1 &TIME1 &DATE2 &TIME2 +
&TIMDIF)
CHGVAR VAR(&MSGOUT) VALUE('Msgq QSYSOPR has a +
severity level 99 message: "' || &MSGIN +
*TCAT '", sent from Job:' || %SST(&SENDER +
1 10) |> 'User:' || %SST(&SENDER 11 10) +
|> 'on' |> %SST(&SENDER 46 2) || '/' || +
%SST(&SENDER 48 2) || '/' || %SST(&SENDER +
44 2) |> 'at' |> %SST(&SENDER 50 2) || +
':' || %SST(&SENDER 52 2) || ':' || +
%SST(&SENDER 54 2))
SNDMSG MSG(&MSGOUT) TOUSR(YATESK)
SNDMSG MSG(&MSGOUT) TOUSR(KEPPLERJ)
SNDMSG MSG(&MSGOUT) TOUSR(HOWARDK)
IF COND(&TIME < '070000') +
THEN(SNDMSG MSG(&MSGOUT) TOUSR(GILBERTN))
/* If message has been in queue more than 30 minutes, notify pager system */
IF COND(&TIMDIF > 30) THEN(DO)
RBASNDMSG MSG(&MSGOUT) TOPG(@DP)
ENDDO
ENDDO
GOTO CMDLBL(LOOP)
RESET: CHGMSGQ MSGQ(QSYSOPR) RESET(*YES)
MONMSG MSGID(CPF0000)
RETURN
ENDPGM: CHGMSGQ MSGQ(QSYSOPR) RESET(*YES)
MONMSG MSGID(CPF0000)
RETURN
ENDPGM
|--------------------------------------------------------------------| |Kirk R. Yates Pattonville School District| |(314) 213-8045 Director of Data Processing| |yatesk@pattonville.k12.mo.us St Ann, MO | |--------------------------------------------------------------------|
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2025 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
