|
midrange.com
>
> What's a good way to retrieve the full message or message data associated
> with a failed call to QCMDEXC ?
>
I suppose the "right" way is to call QCAPCMD instead of QCMDEXC. With
QCAPCMD you get the "QUSEC" API data structure as a parameter, so you can
get the message data from that.
But, I'm not a huge fan of QCAPCMD, it's just too complicated :) So, I
tend to just receive the message data from the program message queue.
This routine, by the way, was originally written to receive message
CPF5027 when a record is locked so that I can get the details of who is
locking a record -- but it works for your purpose too...
Here's a sample program that demonstrates:
H DFTACTGRP(*NO)
**************************************
** start data taken from /copy member
**************************************
D MSG_DATA DS qualified
D based(prototype_only)
D ID 7A
D Sev 10I 0
D Type 2A
D Key 4A
D Data 4096A varying
** Message types in the MSG_DATA.Type field:
D MSGTYPE_COMP C '01'
D MSGTYPE_DIAG C '02'
D MSGTYPE_INFO C '04'
D MSGTYPE_INQ C '05'
D MSGTYPE_SNDCPY C '06'
D MSGTYPE_RQS C '08'
D MSGTYPE_RQSPMT C '10'
D MSGTYPE_NOTIFY C '14'
D MSGTYPE_ESCAPE C '15'
D MSGTYPE_NOTERR C '16'
D MSGTYPE_ESCERR C '17'
D MSGTYPE_RPY C '21'
D MSGTYPE_VLDRPY C '22'
D MSGTYPE_DFTRPY C '23'
D MSGTYPE_SYSDFT C '24'
D MSGTYPE_SYSRPY C '25'
D MSG_find PR 1N
D peMsgID 7A const
D peStackCnt 10I 0 value
D peDta likeds(MSG_DATA)
**************************************
** end data taken from /copy member
**************************************
D psds sds
D psds_msgid 40 46A
D Command PR ExtPgm('QCMDEXC')
D CmdStr 32702 const options(*varsize)
D CmdLen 15p 5 const
D CmdStr s 100A varying
D err ds likeds(MSG_DATA)
C eval CmdStr = 'STRCMTCTL LCKLVL(*CHG)'
c callp(e) Command(cmdStr: %len(cmdStr))
c if %error
c if MSG_find(psds_msgid: 1: err) = *ON
** the err structure now contains the full message details
c endif
c endif
c eval *inlr = *on
**************************************
** Start data from SRVPGM
**************************************
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* MSG_find(): Search a program's message queue for the last
* time a given MsgID was found.
*
* peMsgID = (input) message ID to search for
* peStackCnt = (input) call-stack entry to search
* peDta = (output) MSG_DATA structure w/returned msg info
*
* Returns *ON if successful, *OFF otherwise
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P MSG_find B export
D MSG_find PI 1N
D peMsgID 7A const
D peStackCnt 10I 0 value
D peDta likeds(MSG_DATA)
D QMHRCVPM PR ExtPgm('QMHRCVPM')
D MsgInfo 32766A options(*varsize)
D MsgInfoLen 10I 0 const
D Format 8A const
D StackEntry 10A const
D StackCount 10I 0 const
D MsgType 10A const
D MsgKey 4A const
D WaitTime 10I 0 const
D MsgAction 10A const
D ErrorCode 1024A options(*varsize)
D dsM1 DS
D dsM1_BytRtn 10I 0
D dsM1_BytAvl 10I 0
D dsM1_MsgSev 10I 0
D dsM1_MsgID 7A
D dsM1_MsgType 2A
D dsM1_MsgKey 4A
D dsM1_Reserv1 7A
D dsM1_CCSID_st 10I 0
D dsM1_CCSID 10I 0
D dsM1_DtaLen 10I 0
D dsM1_DtaAvl 10I 0
D dsM1_Dta 4096A
D dsEC DS
D dsEC_BytesP 1 4I 0 INZ(%size(dsEC))
D dsEC_BytesA 5 8I 0 INZ(0)
D dsEC_MsgID 9 15
D dsEC_Reserv 16 16
D dsEC_MsgDta 17 256
D wwMsgKey S 4A
*************************************************
* Search program's message queue
*************************************************
c eval wwMsgKey = *ALLx'00'
c dou dsEC_BytesA > 0
c or dsM1_MsgID = PSDS_msgid
c callp QMHRCVPM(dsM1: %size(dsM1): 'RCVM0100':
c '*': peStackCnt: '*PRV': wwMsgKey:
c 0: '*SAME': dsEC)
c eval wwMsgKey = dsM1_MsgKey
c enddo
C*********************************************************
c* Handle error
C*********************************************************
c if dsEC_BytesA > 0
c return *Off
c endif
*********************************************************
* return the result
*********************************************************
c eval peDta.ID = dsM1_MsgID
c eval peDta.Sev = dsM1_MsgSev
c eval peDta.Type = dsM1_MsgType
c eval peDta.Key = dsM1_MsgKey
c eval peDta.Data =
c %subst(dsM1_Dta: 1: dsM1_DtaLen)
c return *on
P E
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.
