× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.



Hi
I posted previously that QSYSMSG does not get all critical messages.
Some messages go to only QSYSOPR.

If you have a checker running on QSYSMSG my idea is to check QSYSOPR
periodically and send a message to QSYSMSG, to hopefully pick up the
critical messages sent only to QSYSOPR.
Note that this program creates a file in QGPL/@@MSGSKEY.

I wrote a program GETMESSAGE. Call GETMESSAGE ('QSYSOPR' ' ')
It uses msg APIs to do the checking. Gets messages with text
'*Attention' and Sev > 20.
One point bothers me. The manual says that while api QGYOLMSG is
active, messages could be prevented from being sent to the queue being
retrieved, in my case, QSYSOPR. My question is has anyone had
problems with this api in that it may prevent messages being set to
QSYSOPR?


// GET MESSAGES FROM QSYSOPR

*
*

h dftactgrp(*no)

d GETMESSAGE pr
d MsgQName 10 const
d Func 1

d GETMESSAGE pi
d MsgQName 10 const
d Func 1

D*Description: The QGYOLMSG API gets mesages from a mesage queue
************************************************
* DS for the API
dOpnMsgs pr extpgm('QGYOLMSG')
d RcvVar 1 options(*varsize)
d LenRcvVar 10i 0 const
d ListInfo 80
d NbrRcdRqs 10i 0 const
d SortInfo const likeds(QGYOSI)
D MsgSelect 1 options(*varsize)
D SizeMsgSelect 10i 0
D QueueInfo 21a
D MsgQ 44a
d QUSEC likeds(QUSEC)

dGetNextEnt pr extpgm('QGYGTLE')
d RcvVar 1 options(*varsize)
d LenRcvVar 10i 0 const
d RqsHandle 4 const
d ListInfo 80
d NbrRcdRqs 10i 0 const
d StrRcd 10i 0 const
d QUSEC likeds(QUSEC)
d
dCloseList pr extpgm('QGYCLST')
d RqsHandle 4 const
d QUSEC likeds(QUSEC)
*******************************************************
* DS for the API to SELECT which Messages to get
D MsgSelectDs Ds Qualified
D ListDir 10a Inz('*NEXT')
D Reserved 2a
D SevCriteria 10i 0 Inz(0)
D MaxMsgLen 10i 0 Inz( %len(FldVarEntry.Data))
D MaxMsgHelpLen 10i 0 Inz( %len(FldVarEntry.Data))
D OffsetCriteria...
D 10i 0 Inz(44)
D NumberCriteria...
D 10i 0 Inz(1)
D OffsetMsgKey 10i 0 Inz(54)
D OffsetFieldID 10i 0 Inz(58)
D NumberFieldsRet...
D 10i 0 Inz(2)
D Criteria 10a Dim(1)
D Inz('*ALL')
D MsgKey 4a Dim(1)
D Fields 10i 0 Dim(2)

dRcvVar ds 64000

******************************************************
* DS for the Message
D ReceiverDs ds Qualified
D NextOffset 10i 0
D FieldsOffset 10i 0
D NumFields 10i 0
D MsgSeverity 10i 0
D MsgId 7a
D MsgType 2a
D MsgKey 4a
D MsgFile 10a
D MsgFileLib 10a
D MsgQ 10a
D MsgQLib 10a
D Date 7a
D Time 6a
D MicroSec 6a
D Reservedfield 1a
******************************************
* DS for the MESSAGE DATA
dFldVarEntry ds based(FldVarEntPtr)
d qualified
D NextOffsetInfo...
D 10i 0
D LenFieldInfo 10i 0
D FieldID 10i 0
D DataType 1a
D DataStatus 1a
D Reserved 14a
D DataLen 10i 0
D Data 512a


dRcvVarEntry ds based(RcvVarEntPtr)
d qualified
d Hdr likeds(ReceiverDS)
d

dFldVarEntPtr s *
dTopVarEntPtr s *


D*Descriptive Name: Common structures for use by QGY API's.
D* List
D*******************************************************************
D*NOTE: These type definitions only define fixed portions of
D* the format. Any varying length fields must be
D* specified by the user.

D* Type Definition for the Sort Information Format
DQGYOSI DS
D* Qgy Olobj SortInfo
D QGYNBRK 1 4B 0

D*List information structure
DQGYLI DS
D* Qgy List Info
D QGYTR07 1 4B 0
D QGYRRTN02 5 8B 0
D QGYRH07 9 12
D QGYRL07 13 16B 0
D QGYIC07 17 17
D QGYNTURY01 18 18
D QGYYEAR02 19 20
D QGYMONTH02 21 22
D QGYD02 23 24
D QGYHOUR02 25 26
D QGYNUTES02 27 28
D QGYCONDS02 29 30
D QGYLSI01 31 31
D QGYERVED56 32 32
D QGYRTNIL01 33 36B 0
D QGYFBR01 37 40B 0
D QGYRSV214 41 80

D*Description: error code parameter.
DQUSEC DS
D QUSBPRV 1 4B 0
D QUSBAVL 5 8B 0
D QUSEI 9 15
D QUSERVED 16 16

D*Structures for date and time
DQGYDATE DS
D* Qgy Date
D QGYYEAR 1 2
D QGYMONTH 3 4
D QGYD 5 6

DQGYTIME DS
D* Qgy Time
D QGYHOUR 1 2
D QGYNUTES 3 4
D QGYCONDS 5 6
DQGYDT10 DS
D* Qgy Date Time
D QGYNTURY 1 1
D QGYYEAR00 2 3
D QGYMONTH00 4 5
D QGYD00 6 7




// SEND MESSAGE TO QSYSMSG
d QMhSndM pr extpgm('QMHSNDM')
d MsgId 7a const
d Msgf 20a const
d MsgDta 32767a const options(*varsize)
d MsgLen 10i 0 const
d MsgTyp 10a const
d MsgQueue 20a const dim(50) options(*varsize)
d MsgQCnt 10i 0 const
d MsgRpyQ 20a const
d MsgKey 4a
d ErrorDS likeds(ErrorDS)

dErrorDS ds Qualified
d BytesProvided 10i 0 Inz(%Size(ErrorDS))
d BytesAvailable 10i 0
d MsgID 7a
d 1a
d Text 500a Varying

* Some variables
D RecLen s 10i 0
D ListInfo s 80a
D NumberRec s 10i 0
D SortInfo s 1a Inz('0')
D SizeMsgSelect s 10i 0
D QueueInfo s 21a
D MsgQ s 44a
d LenRcvVar S 10i 0

d Count s 10i 0

d p#MsgDta s 256a
d p#MsgQueue s 20a dim(1) inz('QSYSMSG QSYS ')
d p#MsgKey s 4a

D WKEY S 50a
D MSGKY S 50a
D
D pos S 10i 0
D string S like(FldVarEntry.data)
D up C 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
D lo C 'abcdefghijklmnopqrstuvwxyz'

d MAIN PR

/FREE
*INLR = *ON;
MAIN();

Begsr *inzsr;

EXEC SQL SET OPTION COMMIT =*NONE;

EXEC SQL
CREATE TABLE QGPL/@@MSGSKEY (MKEY CHAR (50 ) NOT NULL WITH DEFAULT) ;

Endsr;



/END-FREE


//###################################################//
P MAIN B


D MAIN PI


/free

QueueInfo = '0'+MsgQName ;

// set ErrCde bytes provided to 0 to cause exceptions
QUSBPRV = 0;

// Set the type of messages data to retreive
MsgSelectDS.MsgKey(1) = X'00000000';
MsgSelectDs.Fields(1) = 0302;
MsgSelectDs.Fields(2) = 1001;
RecLen = %len(ReceiverDs);
SizeMsgSelect = %len(MsgSelectDs);
LenRcvVar = 1024 * 1024;

// Get the messages in groups of 50 at a time
OpnMsgs(RcvVar: LenRcvVar: QGYLI: 50: '0': MsgSelectDs:
SizeMsgSelect: QueueInfo: MsgQ: QUSEC);

dow (QGYIC07 = 'C') or (QGYIC07 = 'P'); // information returned?
RcvVarEntPtr = %addr(RcvVar);
TopVarEntPtr = %addr(RcvVar);

for Count = 1 to QGYRRTN02;


// Forward a message to QSYSMSG
// Here add logic to test for all the MSGIDS that
// need to be forwarded


FldVarEntPtr = TopVarEntPtr + RcvVarEntry.Hdr.FieldsOffset ;

string = %subst(FldVarEntry.data : 1: FldVarEntry.DataLen);
string = %XLATE(lo:up:string );
pos = %scan ('*ATTENTION' : string);

if (RcvVarEntry.Hdr.MsgSeverity > 20 and pos <> 0) ;

MSGKY = %trim(RcvVarEntry.Hdr.MsgId) +
%trim(RcvVarEntry.Hdr.Date) +
%trim(RcvVarEntry.Hdr.Time) +
%trim(RcvVarEntry.Hdr.MicroSec);

// Check if already reported
EXEC SQL
SELECT MKEY into :WKEY FROM QGPL/@@MSGSKEY
where MKEY = :MSGKY ;

If WKEY <> MSGKY ;
// set up the message to go to QSYSMSG
p#MsgDta = *blanks;
p#MsgDta = 'On QSYSOPR Check. ' +
RcvVarEntry.Hdr.MsgId +' ' +
%subst(FldVarEntry.data : 1: FldVarEntry.DataLen);
QmhSndM( 'CPF9898'
: 'QCPFMSG *LIBL '
: p#MsgDta
: %len(p#MsgDta)
: '*INFO'
: p#MsgQueue
: %elem(p#MsgQueue)
: ' '
: p#MsgKey
: ErrorDS );

EXEC SQL
INSERT INTO QGPL/@@MSGSKEY VALUES(:MSGKY) ;


Endif;
Endif;


RcvVarEntPtr = TopVarEntPtr + RcvVarEntry.Hdr.NextOffset;
Endfor;

if ((QGYFBR01 + QGYRRTN02) < QGYTR07) or
(QGYLSI01 <> '2');
GetNextEnt( RcvVar : LenRcvVar :QGYRH07 :QGYLI :50
:QGYFBR01 + QGYRRTN02 :QUSEC);
else;
leave;
endif;
enddo;

CloseList( QGYRH07 :QUSEC); // close the open list

Return;
/end-free

P MAIN E

As an Amazon Associate we earn from qualifying purchases.

This thread ...


Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2024 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.