Return to the RPG Tips
Message API
The following code will clear the program message queue/ will remove a
specific message from the program message queue and write the messages
to program message queue.
D DS
D MSGLEN 1 4B 0 INZ
D PGMSTK 5 8B 0 INZ
* ==> The following data variable decleration is used to retrive
* the messages from program message queue. For evaluate the
* type of message.
DRCVM0100_Ds DS
D ByteReturn 9B 0 INZ
D ByteAvail 9B 0 INZ
D MsgSever 9B 0 INZ
D MessageID 7 INZ
D MessageTyp 2 INZ
D MessageKy1 4 INZ
D Resserve_1 7 INZ
D CCSID_Flag 9B 0 INZ
D CCSID_RplD 9B 0 INZ
D CCSID_RplL 9B 0 INZ
D MsgRplData 127 INZ
DMessageLen 9B 0 INZ(171)
DFormatName 8 INZ('RCVM0100')
DStackPtr * INZ(*NULL)
DStackCntr 9B 0 INZ(*ZEROS)
DMessageType 10 INZ
DMessageKey 4 INZ
DWaitTime 9B 0 INZ(*ZEROS)
DMessageActn 10 INZ('*SAME')
DLengthStack 9B 0 INZ(16)
DEntryQual 20 INZ('*NONE *NONE ')
DStackType 10 INZ('*PTR')
DCCSID_Set 9B 0 INZ(*ZEROS)
* ==> Data structure for AS/400 APIs to return the error information
* whenever a API is called.
DApiErrDts DS
D ApiErrLen 1 4B 0 INZ(272)
D ApiErrAvl 5 8B 0 INZ
D ApiErrId 9 15A INZ
D ApiErrDta 17 272A INZ
* ==> Parameter for QMHRMVPH (Remove message API)
C PREMOV PLIST
C PARM PGMMSQ
C PARM PGMSTK
C PARM MSGKEY
C PARM TORMV 10
C PARM ApiErrDts
* ==> Parameter for QMHRCVPM (Receive Program Message).
C QMHRCV_Prm PLIST
C PARM RCVM0100_Ds
C PARM MessageLen
C PARM FormatName
C PARM *NULL StackPtr
C PARM *ZEROS StackCntr
C PARM MessageType
C PARM MessageKey
C PARM WaitTime
C PARM MessageActn
C PARM APIErrDts
C PARM LengthStack
C PARM EntryQual
C PARM StackType
C PARM CCSID_Set
* ==> Parameter for QMHSNDPM (To send the message to program msgq)
C PSENDM PLIST
C PARM MSGID 7
C PARM MSGF 20
C PARM MSGDTA 512
C PARM 512 MSGLEN
C PARM '*INFO' MSGTYP 10
C PARM PGMMSQ 10
C PARM *ZEROS PGMSTK
C PARM MSGKEY 4
C PARM ApiErrDts
* +---------------------------------------------------------------+ *
* ? $MsgHndlr : This subroutine will clear or send messages ? *
* ? to the program message queue. ? *
* ? ? *
* ? Basic Inp : ERRFNCTYP - (C)lear or (E) or Blanks ? *
* ? PREMOV - Variables declared under PREMOV ? *
* ? parameter list. ? *
* ? PSENDM - Variables declared under PSENDM ? *
* ? parameter list. ? *
* +---------------------------------------------------------------+ *
C $MSGHNDLR BEGSR
C EVAL PgmMsq = PgmName
C MOVE *IN89 ErrIND89 1
* ==> Clear the program message queue when ERRFNCTYP = (C)lear.
C SELECT
C WHEN ErrFncTyp = 'C'
C EVAL PGMSTK = *ZEROS
C EVAL MSGKEY = *BLANKS
C EVAL TORMV = '*ALL'
C CALL 'QMHRMVPM' PREMOV 8989
C RESET ErrFncTyp
* ==> Remove unwanted message. This part will retain only those message
* which was written by the application and not by the system.
C WHEN ErrFncTyp = 'E'
C RESET ErrFncTyp
C RESET RCVM0100_Ds
C RESET MessageActn
C EVAL MessageType = '*NEXT'
C EVAL MessageKey = X'00000000'
C CALL 'QMHRCVPM' QMHRCV_Prm
C DOW MessageID <> *BLANKS
C IF MessageTyp <> '04'
C EVAL PGMSTK = *ZEROS
C EVAL MSGKEY = MessageKy1
C EVAL TORMV = '*BYKEY'
C CALL 'QMHRMVPM' PREMOV 8989
C ENDIF
C RESET RCVM0100_Ds
C RESET MessageActn
C EVAL MessageType = '*NEXT'
C EVAL MessageKey = MessageKy1
C CALL 'QMHRCVPM' QMHRCV_Prm
C ENDDO
* ==> Write the message to the program message queue.
C OTHER
C EVAL MSGF = 'QCPFMSGF *LIBL '
C CALL 'QMHSNDPM' PSENDM 8989
C EVAL MSGID = *BLANKS
C EVAL MSGDTA = *BLANKS
C ENDSL
C EVAL *IN89 = ErrIND89
C ENDSR
[report a broken link by clicking here]