|
> > 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.