× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.


  • Subject: Re: Message API
  • From: vsreeniv@xxxxxxxx
  • Date: Wed, 23 Feb 2000 14:01:31 -0500


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

+---
| This is the RPG/400 Mailing List!
| To submit a new message, send your mail to RPG400-L@midrange.com.
| To subscribe to this list send email to RPG400-L-SUB@midrange.com.
| To unsubscribe from this list send email to RPG400-L-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator: david@midrange.com
+---


As an Amazon Associate we earn from qualifying purchases.

This thread ...


Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2024 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.