send message to subfile message file

[jamief]

DDS

     A*=================================================================
     A* Message subfile stuff.                                          
     A*=================================================================
     A          R MSGSFL                    SFL                         
     A*%%TS  SD  20060714  100252       REL-V5R3M0  5722-WDS     
     A                                      SFLMSGRCD(24)               
     A            MSGKEY                    SFLMSGKEY                   
     A            PGMQ                      SFLPGMQ(10)                 
     A*=================================================================
     A* Message subfile stuff                                           
     A*=================================================================
     A          R MSGCTL                    SFLCTL(MSGSFL)              
     A*%%TS  SD  20060714  100252      REL-V5R3M0  5722-WDS     
     A                                      SFLDSP                      
     A                                      SFLDSPCTL                   
     A                                      SFLINZ                      
     A N03                                  SFLEND                      
     A                                      SFLSIZ(0002)                
     A                                      SFLPAG(0001)                
     A            PGMQ                      SFLPGMQ(10)

Program

~
      *
      * PROGRAM - send message to subfile message Queue
      *--------------------------------------------------------
     d messagecsc      s             10i 0
     d messagedata     s             80A
     d messagekey      s              4A
     d messagelen      s             10i 0
     d messagefile     s             20    inz('LBIMSG    *LIBL')
     d messageid       s              7
      *
      *
      * Program Info
      *
     d                SDS
     d  @PGM                 001    010

     d $sendmsg        PR                  ExtPgm('QMHSNDPM')
     d   MessageID                    7A   Const
     d   QualMsgF                    20A   Const
     d   MsgData                    256A   Const
     d   MsgDtaLen                   10I 0 Const
     d   MsgType                     10A   Const
     d   CallStkEnt                  10A   Const
     d   CallStkCnt                  10I 0 Const
     d   MessageKey                   4A
     d   ErrorCode                  256A

     d APIError        DS                  Qualified
     d  BytesP                 1      4I 0 inz(%size(apiError))
     d  BytesA                 5      8I 0 inz(0)
     d  Messageid              9     15
     d  Reserved              16     16
     d  messagedta            17    256

      /Free

        //--------------------------------------------------------
        // MAIN PROGRAM
        //--------------------------------------------------------



            messageid   = 'PCH7601';
            messagedata = *blanks;
            messagelen = %len(%trim(messagedata));

            $sendmsg(messageID   :
                     messageFile :
                     messagedata :
                     messageLen  :
                     '*DIAG'     :
                     @PGM        :
                     messagecsc  :
                     messagekey  :
                     APIError
                                 );


            *inlr = *on;

      /End-Free

[jamief]

Re: send message to subfile message file

clear program messageQ

~
d $clearmsg       pr                  extpgm('QMHRMVPM')   
d   messageq                   276a   const                
d   CallStack                   10i 0 const                
d   Messagekey                   4a   const                
d   messagermv                  10a   const                
d   ErrorCode                  256                         

  //-------------------------------------------------------- 
  // $clrmsg - clear all subfile message(s)                  
  //-------------------------------------------------------- 
                                                             
       begsr $clrmsg;                                        
                                                             
         $clearmsg('*'      :                                
                   *zero    :                                
                   *blanks  :                                
                   '*ALL'   :                                
                   APIError                                  
                            );                               
                                                             
       endsr;