How to modify OPRMONE

41370 pts.
Tags:
AS/400
I recently downloaded OPRMONE which allows me ot monitor QSYSOPR and send messages to my phone when I have an error.

It works fine as designed. I would like to modify it to include the JobName/User/Number. I have not worked much with APIs. I am assuming the QMHLSTM API will get this information, but I could use some guidance on how to make the modifications.

Here is the code:

F**************************************************************** F* OBJECT ID: Oprmone                                             F* TEXT:      MONITOR qsysopr msgs   e-mail a person              F* Jul 14/04  S.R.Pascas                                          F**************************************************************** foprmonemsgIT   F   71        disk D message         S            198                                d desc            s             50                                d test            s             20                                d editword5       C                   '  :  :  '                  D aryM            s              7    DIM(500) fromfile(oprmonemsg D arysent         s             20    DIM(5000)                   D SpacePtr        s               *   inz(*null) d* D GeneralDs       DS                  based(spaceptr) D  InputSize            113    116B 0 D  OFFSETHDR            117    120b 0 D  ListOffset           125    128B 0 D  ListNbr              133    136B 0 D  EntrySize            137    140B 0 D userspace       S             20 D SIZEinfo        S             10i 0 inz(%SiZE(MSGINFO))         d formatsize      s             10i 0 INZ(%size(qlstm0100)) d offset          s             10i 0 D OBJTYPE         S             10 D SpaceLen        s             10i 0 inz(2048)                   D SpaceAtrib      S             10                                D SpaceValue      S              1    INZ(X'00')                  D SpaceAuth       S             10    INZ('*ALL')                 D SpaceText       S             50 D SpaceReplc      S             10    INZ('*YES')                 D FormatName      S              8    inz('LSTM0100') D msgformat       S              8    INZ('MSLT0200') D POS             s              4  0 D sent            s              5  0 inz(0)                      D scandata        s             64 D SIZE            s              4  0 d*  Error code data D ErrorDS         DS D   BytesProv             1      4B 0 Inz( 272 ) D   errorAval             5      8B 0 D   ExcpId                9     15A D   Reserved             16     16A D   ExcpData             17    272A D                SDS D  S1SWID               244    253 D  S1USER               254    263 d DmSGINFO          DS D MAXMSG                        10i 0          inz(-1) D listdir                       10             inz('*NEXT') D selcriteria                   10             inz('*MNR')        D sevcriteria                   10i 0          inz(0) D maxlength                     10i 0          inz(112) D maxHELP                       10i 0          inz(4) D*OFFSETQ                       10i 0          inz(56) D OFFSETQ                       10i 0          inz(80) D*OFFSETKEY                     10i 0          inz(76) D OFFSETKEY                     10i 0          inz(100) D NUMBERQUEUES                  10i 0          INZ(1) D*OFFSETIDENTS                  10i 0          inz(80) D OFFSETIDENTS                  10i 0          inz(104) D FIELDSRETURN                  10i 0          inz(1) d charcode                      10I 0          inz(65535) d datetime                      13 d reserve                        3 d reserve2                      10I 0          inz(0) D QSYSOPr                       20    inz('QSYSOPR   QSYS      ') D msgkey                         4    inz(X'00000000') D identifiers                   10i 0          inz(302) d*

DQLSTM0100        DS D*                                             Qmh Lstm LSTM0100 D NEXTENTRY               1      4B 0 D*                                             Offset Next Entry D NEXTSIZE                5      8B 0 D*                                             Offset Field Return D QMHNBRFR04              9     12B 0 D*                                             Number Field Return D MSGSEV                 13     16B 0 D*                                             Message Severity D MSGID#                 17     23 D*                                             Message Id D QMHMT00                24     25 D*                                             Message Type D QMHMK00                26     29 D*                                             Message Key D QMHMFILN00             30     39 D*                                             Message File Name D QMHMFSL00              40     49 D*                                             Message File Send L D QMHMQN01               50     59 D*                                             Message Queue Name D QMHMQLIB               60     69 D*                                             Message Queue Libra D MSGDATE                70     76                                D*                                             Send Date D MSGTIME                77     82                                D*                                             Send Time D T                     109    109 D RSRV                  111    124 D ld                    125    128b 0 Dmessagedata      DS D msg                     1    256 D msg128                  1    128                                d D CREATESPACE     pr                  Extpgm('QUSCRTUS')          d userspace                     20                                d spaceatrib                    10                                d spacelen                      10i 0                             d spacevalue                     1                                d spaceauth                     10                                d spacetext                     50                                d spacereplc                    10                                d errors                              like(errords)                                                                                 d getmessages     pr                  Extpgm('QMHLSTM')           d userspace                     20                                d formatname                     8                                d msginf                              like(msginfo)               d sizeinfo                      10i 0                             d msgformat                      8                                d errors                              like(errords)               D RTVGENINFO      pr                  Extpgm('QUSPTRUS')          d userspace                     20                                d spaceptr                        *                               D RTVSPACE1       pr                  Extpgm('QUSRTVUS') d userspace                     20 d listoffset                     9b 0 d formatsize                    10i 0 d LSTM0100                            LIKE(QLSTM0100) d D RTVSPACE2       pr                  Extpgm('QUSRTVUS') d userspace                     20 d formatname                    10i 0                             d LD                             9b 0 d messagedta                          LIKE(MESSAGEDATA)           D delay           pr                                              d freqseconds                    4  0                             D sendemail       pr                                              d message                      198                                d desc                          50                                c     *entry        plist C                   parm                    FREQUENCY        15 5 C                   parm                    CYYMMDDHHMMSS    13   C                   parm                    sysname           8   C                   do C                   if        %parms  <> 3                        C                   seton                                        l C                   leave C                   endif c* C     60            mult      frequency     freqseconds       4 0 C                   EVAL      UserSpace = ('OPRMONE   QTEMP') C                   EVAL      datetime  = cyymmddhhmmss  *  Create user space C                   callp     CREATESPACE(userspace:spaceatrib:   C                             spacelen:spacevalue:spaceauth:      C                             spacetext:spacereplc:errords)       c*  Retrieve Pointer   (general info about user space)            C                   EVAL      UserSpace = ('OPRMONE   QTEMP')     C                   CALLp     RTVGENINFO(userspace:spaceptr)      C                   exsr      RTVmessages                         c                   enddo C*********************************************************        C* retrieve  messages                                    *        C*********************************************************        C     RTVmESSAGES   BEGSR                                         C     *inlr         doweq     *off                                c*  get messages into userspace                                   C                   EVAL      UserSpace = ('OPRMONE   QTEMP')     C                   callp     getmessages(userspace:FORMATNAME:   c                             MSGINFO:SIZEINFO:MSGFORMAT:ERRORDS) C                   if        erroraval = 0                       C                   EVAL      LISTOFFSET = LISTOFFSET + 1         C                   do        listnbr                             C                   callp     RTVSPACE1(USERSPACE:listOFFSET:forma c                             :qlstm0100)                         C                   eval      offset = listoffset + 128           C                   eval      msg128 = *blanks                    C                   callp     RTVSPACE2(USERSPACE:OFFSET:LD:MESSAG C                   do                                            c* see if message is to be bypassed                               C                   eval      pos = %lookup(msgid#:arym)          C                   if        POS >=  1                           C                   iter                                          C                   endif                                         c* see if message has already been sent                           C                   eval      test = msgid# + msgdate + msgtime   C                   eval      pos = %lookup(test:arysent)         C                   if        POS <> 0                            C                   iter                                          C                   endif                                         C                   exsr      preparemsg                          C                   enddo                                         C                   EVAL      LISTOFFSET =  NEXTENTRY +1          c                   enddo                                         C                   callp     DELAY(FREQSECONDS)                  c                   endif                                         c                   enddo                                         c                   endsr                                         C*********************************************************        C* prepare message                                       *        C*********************************************************        C     preparemsg    BEGSR                                         C                   if        sent < 5000                         C                   add       1             sent                  C                   eval      arysent(sent) = msgid# + msgdate + m c                   endif                                         C                   time                    timex            12 0 C                   time                    time6             6 0 C                   eval      %SUBST(message:1:16) ='System: ' + s C                   eval      %SUBST(message:20:16) ='Error: '    C                   eval      %SUBST(message:40:25) ='Date/time: ' C                             %subst(msgdate:2:6) + ' ' + msgtime C                   eval      %SUBST(message:70:128) =MSG128      C                   eval      desc ='OprmonE Warning: ' + sysname c                             %EDITW(TIME6   : EDITWORD5)         C                   callp     SENDEMAIL(MESSAGE:DESC)             C                   endsr                                                             * * * *  E N D  O F  S O U R C E  * * * *



Software/Hardware used:
AS400 V5R4

Answer Wiki

Thanks. We'll let you know when a new response is added.

I made a couple minor changes (untested!) that should be very close to requesting what you need. I’m expecting the changes to be ‘Bold’ in the program text. Note that <i>requesting</i> is separate from <i>processing</i> what gets returned. I have made no changes yet to how the data is processed. By executing the modified request, you should see how the qualified job name is inserted into the user space.
<pre>
SEQNBR*…+… 1 …+… 2 …+… 3 …+… 4 …+… 5 …+… 6 …+… 7 ..
100 F****************************************************************
200 F* OBJECT ID: Oprmone
300 F* TEXT: MONITOR qsysopr msgs e-mail a person
400 F* Jul 14/04 S.R.Pascas
500 F****************************************************************
600 foprmonemsgIT F 71 disk
700 D message S 198
800 d desc s 50
900 d test s 20
1000 d editword5 C ‘ : : ‘
1100 D aryM s 7 DIM(500) fromfile(oprmonemsg)
1200 D arysent s 20 DIM(5000)
1300 D SpacePtr s * inz(*null)
1400 d*
1500 DD GeneralDs DS based(spaceptr)
1600 D InputSize 113 116B 0
1700 D OFFSETHDR 117 120b 0
1800 D ListOffset 125 128B 0
1900 D ListNbr 133 136B 0
2000 D EntrySize 137 140B 0
2100 D userspace S 20
2200 D SIZEinfo S 10i 0 inz(%SiZE(MSGINFO))
2300 d formatsize s 10i 0 INZ(%size(qlstm0100))
2400 d offset s 10i 0
2500 D OBJTYPE S 10
2600 D SpaceLen s 10i 0 inz(2048)
2700 D SpaceAtrib S 10
2800 D SpaceValue S 1 INZ(X’00′)
2900 D SpaceAuth S 10 INZ(‘*ALL’)
3000 D SpaceText S 50
3100 D SpaceReplc S 10 INZ(‘*YES’)
3200 D FormatName S 8 inz(‘LSTM0100′)
3300 D msgformat S 8 INZ(‘MSLT0200′)
3400 D POS s 4 0
3500 D sent s 5 0 inz(0)
3600 D scandata s 64
3700 D SIZE s 4 0
3800 d* Error code data
3900 D ErrorDS DS
4000 D BytesProv 1 4B 0 Inz( 272 )
4100 D errorAval 5 8B 0
4200 D ExcpId 9 15A
4300 D Reserved 16 16A
4400 D ExcpData 17 272A
4500 D SDS
4600 D S1SWID 244 253
4700 D S1USER 254 263
4800 d
4900 DmSGINFO DS
5000 D MAXMSG 10i 0 inz(-1)
5100 D listdir 10 inz(‘*NEXT’)
5200 D selcriteria 10 inz(‘*MNR’)
5300 D sevcriteria 10i 0 inz(0)
5400 D maxlength 10i 0 inz(112)
5500 D maxHELP 10i 0 inz(4)
5600 D*OFFSETQ 10i 0 inz(56)
5700 D OFFSETQ 10i 0 inz(80)
5800 D*OFFSETKEY 10i 0 inz(76)
5900 D OFFSETKEY 10i 0 inz(100)
6000 D NUMBERQUEUES 10i 0 INZ(1)
6100 D*OFFSETIDENTS 10i 0 inz(80)
6200 D OFFSETIDENTS 10i 0 inz(104)
6300 <b>D FIELDSRETURN 10i 0 inz(2)</b>
6400 d charcode 10I 0 inz(65535)
6500 d datetime 13
6600 d reserve 3
6700 d reserve2 10I 0 inz(0)
6800 D QSYSOPr 20 inz(‘QSYSOPR QSYS ‘)
6900 D msgkey 4 inz(X’00000000′)
7000 <b>D identifier1 10i 0 inz(302)</b>
7001 <b>D identifier2 10i 0 inz(601)</b>
7100 d*
7200
7300 DQLSTM0100 DS
7400 D* Qmh Lstm LSTM0100
7500 D NEXTENTRY 1 4B 0
7600 D* Offset Next Entry
7700 D NEXTSIZE 5 8B 0
7800 D* Offset Field Returned
7900 D QMHNBRFR04 9 12B 0
8000 D* Number Field Returned
8100 D MSGSEV 13 16B 0
8200 D* Message Severity
8300 D MSGID# 17 23
8400 D* Message Id
8500 D QMHMT00 24 25
8600 D* Message Type
8700 D QMHMK00 26 29
8800 D* Message Key
8900 D QMHMFILN00 30 39
9000 D* Message File Name
9100 D QMHMFSL00 40 49
9200 D* Message File Send Lib
9300 D QMHMQN01 50 59
9400 D* Message Queue Name
9500 D QMHMQLIB 60 69
9600 D* Message Queue Library
9700 D MSGDATE 70 76
9800 D* Send Date
9900 D MSGTIME 77 82
10000 D* Send Time
10100 D T 109 109
10200 D RSRV 111 124
10300 D ld 125 128b 0
10400 Dmessagedata DS
10500 D msg 1 256
10600 D msg128 1 128
10700 d
10800 D CREATESPACE pr Extpgm(‘QUSCRTUS’)
10900 d userspace 20
11000 d spaceatrib 10
11100 d spacelen 10i 0
11200 d spacevalue 1
11300 d spaceauth 10
11400 d spacetext 50
11500 d spacereplc 10
11600 d errors like(errords)
11700
11800 d getmessages pr Extpgm(‘QMHLSTM’)
11900 d userspace 20
12000 d formatname 8
12100 d msginf like(msginfo)
12200 d sizeinfo 10i 0
12300 d msgformat 8
12400 d errors like(errords)
12500 D RTVGENINFO pr Extpgm(‘QUSPTRUS’)
12600 d userspace 20
12700 d spaceptr *
12800 D RTVSPACE1 pr Extpgm(‘QUSRTVUS’)
12900 d userspace 20
13000 d listoffset 9b 0
13100 d formatsize 10i 0
13200 d LSTM0100 LIKE(QLSTM0100)
13300 d
13400 D RTVSPACE2 pr Extpgm(‘QUSRTVUS’)
13500 d userspace 20
13600 d formatname 10i 0
13700 d LD 9b 0
13800 d messagedta LIKE(MESSAGEDATA)
13900 D delay pr
14000 d freqseconds 4 0
14100 D sendemail pr
14200 d message 198
14300 d desc 50
14400 c *entry plist
14500 C parm FREQUENCY 15 5
14600 C parm CYYMMDDHHMMSS 13
14700 C parm sysname 8
14800 C do
14900 C if %parms <> 3
15000 C seton lr
15100 C leave
15200 C endif
15300 c*
15400 C 60 mult frequency freqseconds 4 0
15500 C EVAL UserSpace = (‘OPRMONE QTEMP’)
15600 C EVAL datetime = cyymmddhhmmss
15700 * Create user space
15800 C callp CREATESPACE(userspace:spaceatrib:
15900 C spacelen:spacevalue:spaceauth:
16000 C spacetext:spacereplc:errords)
16100 c* Retrieve Pointer (general info about user space)
16200 C EVAL UserSpace = (‘OPRMONE QTEMP’)
16300 C CALLp RTVGENINFO(userspace:spaceptr)
16400 C exsr RTVmessages
16500 c enddo
16600 C*********************************************************
16700 C* retrieve messages *
16800 C*********************************************************
16900 C RTVmESSAGES BEGSR
17000 C *inlr doweq *off
17100 c* get messages into userspace
17200 C EVAL UserSpace = (‘OPRMONE QTEMP’)
17300 C callp getmessages(userspace:FORMATNAME:
17400 c MSGINFO:SIZEINFO:MSGFORMAT:ERRORDS)
17500 C if erroraval = 0
17600 C EVAL LISTOFFSET = LISTOFFSET + 1
17700 C do listnbr
17800 C callp RTVSPACE1(USERSPACE:listOFFSET:formats
17900 c :qlstm0100)
18000 C eval offset = listoffset + 128
18100 C eval msg128 = *blanks
18200 C callp RTVSPACE2(USERSPACE:OFFSET:LD:MESSAGED
18300 C do
18400 c* see if message is to be bypassed
18500 C eval pos = %lookup(msgid#:arym)
18600 C if POS >= 1
18700 C iter
18800 C endif
18900 c* see if message has already been sent
19000 C eval test = msgid# + msgdate + msgtime
19100 C eval pos = %lookup(test:arysent)
19200 C if POS <> 0
19300 C iter
19400 C endif
19500 C exsr preparemsg
19600 C enddo
19700 C EVAL LISTOFFSET = NEXTENTRY +1
19800 c enddo
19900 C callp DELAY(FREQSECONDS)
20000 c endif
20100 c enddo
20200 c endsr
20300 C*********************************************************
20400 C* prepare message *
20500 C*********************************************************
20600 C preparemsg BEGSR
20700 C if sent < 5000
20800 C add 1 sent
20900 C eval arysent(sent) = msgid# + msgdate + msg
21000 c endif
21100 C time timex 12 0
21200 C time time6 6 0
21300 C eval %SUBST(message:1:16) =’System: ‘ + sys
21400 C eval %SUBST(message:20:16) =’Error: ‘ +
21500 C eval %SUBST(message:40:25) =’Date/time: ‘
21600 C %subst(msgdate:2:6) + ‘ ‘ + msgtime
21700 C eval %SUBST(message:70:128) =MSG128
21800 C eval desc =’OprmonE Warning: ‘ + sysname +
21900 c %EDITW(TIME6 : EDITWORD5)
22000 C callp SENDEMAIL(MESSAGE:DESC)
22100 C endsr
* * * * E N D O F S O U R C E * * * *</pre>

Discuss This Question: 5  Replies

 
There was an error processing your information. Please try again later.
Thanks. We'll let you know when a new response is added.
Send me notifications when members answer or reply to this question.

REGISTER or login:

Forgot Password?
By submitting you agree to receive email from TechTarget and its partners. If you reside outside of the United States, you consent to having your personal data transferred to and processed in the United States. Privacy
  • TomLiotta
    Any chance you could post that in a {code} block? It'd sure make review easier. Tom
    125,585 pointsBadges:
    report
  • TomLiotta
    Just to ensure that I understand, it looks like you are currently requesting a single key (FIELDSRETURN inz(1)) for 0302="Message with replacement data" (identifiers inz(302)). You would like to make FIELDSRETURN=2 in order to add an identifier for field 0601="Qualified sender job name". Am I on track? Tom
    125,585 pointsBadges:
    report
  • TomLiotta
    I am assuming the QMHLSTM API will get this information,... I should have also said that the API will get that info (assuming that I understand correctly). You appear on the right track and possibly can make minimal changes. (Some changes could be recommended, but they might be better left until after you see how to request what you want, what all gets returned and how it's all structured both for input to the API and output from it.) You probably saw that "Qualified sender job name” was listed in the API docs, which prompted your question. If that's what you're after, the difference between what you already have and what you need is small. But it can be kind of like coding a trigger program with hard-coded buffer offsets. It can work perfectly for a long time... then you make a small change, and !@#$%^... Best to grasp fully "what you need" first. Then we'll make a little larger change to get to "what you should have". Tom
    125,585 pointsBadges:
    report
  • CharlieBrowne
    Thanks Tom I got pulled away for some other project. I'll update this after I get I changve to test it out.
    41,370 pointsBadges:
    report
  • TomLiotta
    2200      D SIZEinfo        S             10i 0 inz(%SiZE(MSGINFO))
    I assume that you know that the above line allows for something like adding a second element to the "identifiers array" without needing to update the SIZEinfo value. But it's probably worth mentioning it for the sake of the thread. Others may follow in the track you started. Tom
    125,585 pointsBadges:
    report

Forgot Password

No problem! Submit your e-mail address below. We'll send you an e-mail containing your password.

Your password has been sent to:

To follow this tag...

There was an error processing your information. Please try again later.

REGISTER or login:

Forgot Password?
By submitting you agree to receive email from TechTarget and its partners. If you reside outside of the United States, you consent to having your personal data transferred to and processed in the United States. Privacy

Thanks! We'll email you when relevant content is added and updated.

Following