* The prototype:
D SndPgmMsg pr extpgm('QMHSNDPM')
D MsgID 7a Const
D MsgFName 20a Const
D MsgDta 32767a Const Options(*Varsize)
D MsgDtaLength 9b 0 Const
D MsgType 10a Const
D CallStackE 10a Const Options(*Varsize)
D CallStackC 9b 0 Const
D MsgKey 4a
D Error 32767a Options(*Varsize)
* Optional Parameter Group 1
D CallStackEL 9b 0 Const Options(*Nopass)
D CallStackEQ 20a Const Options(*Nopass)
D DspPgmMsgWait 9b 0 Const Options(*Nopass)
* Optional Parameter Group 2
D CallStackEDT 10a Const Options(*Nopass)
D MsgCCSID 9b 0 Const Options(*Nopass)
* Procedure for sending:
P SndMsgErr b export
D*
D SndMsgErr pi
D MsgID 7a Const
D* PgmMsgQ 10a Const
D MsgDta 32767a Const Options(*Varsize : *Nopass)
D MsgDtaLen 9b 0 Const Options(*Nopass)
D*
D PgmMsgDta s like(MsgDta)
D PgmDtaLen s like(MsgDtaLen)
D MsgKeyA s 4a
D* PgmCllStck s 10a inz('*')
D PgmCllStck s 10a inz(*blanks)
D PgmCllStckC s 9b 0 inz(0)
D CallStackEL s 9b 0 inz(10)
D CallStackEQ s 20a inz('*NONE')
D DspPgmMsgWait s 9b 0 inz(*zeros)
D CallStackEDT s 10a inz('*CHAR')
D MsgCCSID s 9b 0 inz(0)
*
C reset errc0100
* This contains the name of program invoking the Procedure
C eval PgmCllStck = ZZPgmofProc
* This is used when defining the PGMMSGQ for DSPF
C if %parms = 1
C eval PgmMsgDta = *blanks
C eval PgmDtaLen = *zeros
C else
C eval PgmMsgDta = MsgDta
C eval PgmDtaLen = MsgDtaLen
C endif
C callp SndPgmMsg(MsgId:
* Named constant, can be replaced
C DwhMsg:
C PgmMsgDta:
C PgmDtaLen:
C msgtypinfo:
C PgmCllStck:
C PgmCllStckC:
C MsgKeyA:
C errc0100)
C return
P SndMsgErr e
*The System Data Structure;
Dpsds sds
D ZZProcName 10a
D ZZStatus 5s 0
D ZZPrevSts 5s 0
D ZZSrcLneNbr 8a
D ZZRoutine 8a
D ZZParms 3s 0
D ZZExcType 3a
D ZZExcNbr 4a
D ZZReserve1 4a
D ZZMsgWrkAra 30a
D ZZPgmLib 10a
D ZZExcDta 80a
D ZZ9001ID 4a
D ZZLastFile1 10a
D ZZUnused1 6a
D ZZJobDate 8a
D ZZCentury 2s 0
D ZZLastFile2 8a
D ZZFileSts 35a
D ZZJobName 10a
D ZZUserID 10a
D ZZJobNbr 6s 0
D ZZJobRunDte 6s 0
D ZZSysDate 6s 0
D ZZSysTime 6s 0
D ZZCompDate 6
D ZZCompTime 6
D ZZCompLvl 4a
D ZZSrcFileName 10a
D ZZSrcFileLib 10a
D ZZSrcFileMbr 10a
D ZZPgmOfProc 10a
D ZZModOfProc 10a
D ZZSid2128 2s 0
D ZZSid228235 2s 0
D ZZCurrentUser 10a
D ZZUnused2 62a
In the program which wants to send a message, a simple CALLP works as
C callp SndMsgErr('CPF9898':MsgDta:%size(MsgDta))
Thanks to John C. Boblitz Jr.
阅读(923) | 评论(0) | 转发(0) |
