| midrange.com code scratchpad |
|
Name:
Dennis Lovelady
|
Scriptlanguage:
Plain Text
|
Tabwidth:
4
|
Date:
07/13/2010 07:34:08 pm
|
IP:
Logged
|
|
|
Description:
QMHSNDPGM to send *INQ message to *EXT queue is not received with QMHRCVPM
|
|
Code:
- H/TITLE Check OOP totals
- H OPTION(*NOSHOWCPY:*NOEXPDDS:*NODEBUGIO:*SRCSTMT) DFTACTGRP(*NO)
-
-
- D QCPFMSGF C 'QCPFMSG *LIBL'
-
-
- D sndPgmMsg PR ExtPgm('QMHSNDPM')
- D MessageID const Like(QUSEI)
- D MessageFile 20 const
- D MessageData 1 const Options(*varsize)
- D LengthMsgDta 10I 0 const
- D MessageType 10 const
- D CallStackEnt 10 const Options(*varsize)
- D CallStkEntCtr 10I 0 const
- D MessageKey Like(QMH_MsgKey)
- D ErrorStruct LikeDS(USEC_T) Options(*varsize)
-
-
- D rcvPgmMsg PR ExtPgm('QMHRCVPM')
- D msgInfo 65535 Options(*VarSize)
- D lenMsgInfo 10I 0 Const
- D fmtName 8 Const
- D callStack 10 Const
- D callStackCtr 10I 0 Const
- D msgType 10 Const
- D msgKey 4 Const
- D waitTime 10I 0 Const
- D msgAction 10 Const
- D errorStruct LikeDS(USEC_T) Options(*VarSize)
-
-
-
- D/Copy qsysinc/qrpglesrc,qusec
- D/Copy QSYSINC/QRPGLESRC,QMHRCVPM
-
-
- D USEC_T DS Qualified based(proto_only)
- D common LikeDS(QUSEC)
- D QUSED01 1024
-
-
- D msgRpyDS DS Qualified
- D com LikeDS(QMHM020000)
- D msgReply 80
-
- D msg S 512 Varying
- D myUSEC DS LikeDS(USEC_T)
- D QMH_MsgKey S 4
- D quit S N Inz(*Off)
-
-
- /Free
- Clear myUSEC ;
- myUSEC.common.QUSBPRV = %Size(myUSEC) ;
- DoU quit ;
- sndPgmMsg(
- 'CPI8859'
- : QCPFMSGF
- : msg: %Len(msg)
- : '*INQ'
- : '*EXT'
- : *Zero
- : QMH_MsgKey
- : myUSEC
- ) ;
- rcvPgmMsg(msgRpyDS: %Size(msgRpyDS): 'RCVM0200'
- : '*EXT': *Zero
- : '*RPY': QMH_msgKey: -1: '*OLD': myUSEC) ;
- EndDO ;
- *INLR = *On ;
-
- /End-free
-
|
|
|
|