H DFTNAME(TESTPROC) DATEDIT(*YMD/) BNDDIR('QC2LE')                                             
     F********** プロシージャーのテスト ************************************                        
     F*                                                                                             
     F**********************************************************************                        
                                                                                                    
      * CRTRPGMOD  OBJ(QTEMP/TESTPROC)   SRCFILE(R610SRC/QRPGLESRC)                                 
      * DBGVIEW(*SOURCE) AUT(*ALL)                                                                  
      * CRTPGM PGM(ASNET.COM/TESTPROC) MODULE(QTEMP/TESTPROC ACTGRP(*NEW)                           
      *        AUT(*ALL)                                                                            
                                                                                                    
      *-------------------------------------------------------------------*                         
      *  2020/08/08 : 作成                                                                          
      *-------------------------------------------------------------------*                         
      *( 作業変数 )                                                                                 
     D MSR             S             80    DIM(1) CTDATA PERRCD(1)               配列               
     D AR              S              1A   DIM(256)                                                 
     D N               S              4S 0                                                          
                                                                                                    
     D*( SNDPGMMSG     のプロトタイプ宣言 )                                                         
     D SNDPGMMSG       PR                                                                           
     D  MSG                        3000A   Vｱﾂﾏｵ                                                    
     D  MSGTYPE_IN                   10A   ﾐｱﾂﾏｵ OPTIONS(*NOPASS)                                   
     D  CALLSTACKC_IN                10I 0 CONST OPTIONS(*NOPASS)                                   
                                                                                                    
     C*( メイン・ルーチンの始まり )                                                                 
     C                   CALLP     SNDPGMMSG(MSR(1))                                                
     C                   SETON                                        LR                            
     C                   RETURN                                                                     
     C*( メイン・ルーチンの終わり )                                                                 
                                                                                                    
     C******************************************************                                        
     C     *INZSR        BEGSR                                                                      
     C******************************************************                                        
     C*  初期 CYCLE のみの実行                                                                      
     C                   ENDSR                                                                      
      *********************************************************                                     
      *   SNDPGMMSG:  メッセージを現在の CALLSTACK に送信     *                                     
      *********************************************************                                     
      *---( SNDPGMMSG PROCEDURE  ここから )------------------------*                                
     P SNDPGMMSG       B                   EXPORT                                                   
     D                 PI                                                                           
     D  MSG                        3000A   Vｱﾂﾏｵ                                                    
     D  MSGTYPE_IN                   10A   ﾐｱﾂﾏｵ OPTIONS(*NOPASS)                                   
     D  CALLSTACKC_IN                10I 0 CONST OPTIONS(*NOPASS)                                   
                                                                                                    
     D APIERR          DS                                                                           
     D  GETBYT                 1      4B 0 INZ(160)                                                 
     D  AVLBYT                 5      8B 0 INZ(0)                                                   
     D  MSGID                  9     15                                                             
     D  MSGDTA                17    160                                                             
                                                                                                    
     D QMHSNDPM        PR                  EﾒﾎPｷﾃ('QMHSNDPM')                                       
     D  MSGID                         7A   CONST                                                    
     D  MSGFILE                      20A   CONST                                                    
     D  MSGDATA                    6000A   CONST OPTIONS(*ﾐｱﾈﾍｹﾔｵ)                                  
     D  MSGDATALEN                   10I 0 CONST                                                    
     D  MSGTYPE                      10A   CONST                                                    
     D  CALLSTACKE                   10A   CONST                                                    
     D  CALLSTACKC                   10I 0 CONST                                                    
     D  MSGKEY                        4A                                                            
     D  APIERR                             LIKEDS(APIERR)                                           
     D                                     OPTIONS(*VARSIZE)                                        
     D PARMS           S              4S 0                                                          
     D MSGKEY          S              4A                                                            
     D CALLSTACKC      S             10I 0 INZ(1)                                                   
     D MSGTYPE         S             10A   INZ('*DIAG     ')                                        
                                                                                                    
     C                   EVAL      PARMS = %PARMS()                                                 
     C                   SELECT                                                                     
     C                   WHEN      PARMS = 1                                                        
     C                   WHEN      PARMS = 2                                                        
     C                   EVAL      MSGTYPE = MSGTYPE_IN                                             
     C                   WHEN      PARMS = 3                                                        
     C                   EVAL      CALLSTACKC = CALLSTACKC_IN                                       
     C                   EVAL      MSGTYPE = MSGTYPE_IN                                             
     C                   ENDSL                                                                      
      /FREE                                                                                         
        QMHSNDPM('CPF9897':'QCPFMSG   *LIBL':MSG:                                                   
                 %LEN(%TRIM(MSG)):MSGTYPE:'*PGMBDY':                                                
                 CALLSTACKC:MSGKEY:APIERR);                                                         
      /END-FREE                                                                                     
     C                   RETURN                                                                     
     P                 E                                                                            
      *---( SNDPGMMSG    PROCEDURE  ここまで )------------------------*                             
                                                                                                    
** MSR -- 以下は配列                                                                                
 これはメッセージ送信のテストです。