Home > IT Answers > AS/400 > How to modify OPRMONE
CharlieBrowne
32,945 pts.
 How to modify OPRMONE
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
ASKED: April 27, 2010  4:03 PM
UPDATED: April 29, 2010  12:55 AM
RELATED QUESTIONS
Answer Wiki:
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>
Last Wiki Answer Submitted:  April 28, 2010  7:56 pm  by  CharlieBrowne   32,945 pts.
All Answer Wiki Contributors:  CharlieBrowne   32,945 pts.
To see all answers submitted to the Answer Wiki: View Answer History.


RSS - Discussions Help
Discuss This Question:
_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _

 

Any chance you could post that in a {code} block? It’d sure make review easier.

Tom

TomLiotta
 108,360 pts.
 

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

TomLiotta
 108,360 pts.
 

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

TomLiotta
 108,360 pts.
 

Thanks Tom
I got pulled away for some other project.
I’ll update this after I get I changve to test it out.

CharlieBrowne
 32,945 pts.
  
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

TomLiotta
 108,360 pts.