H DFTNAME(TESTSUBR) DATEDIT(*YMD/) BNDDIR('QC2LE')                                             
     F********** サブ・ルーチンのテスト ************************************                        
     F*                                                                                             
     F**********************************************************************                        
                                                                                                    
      * CRTRPGMOD  OBJ(QTEMP/TESTSUBR)   SRCFILE(R610SRC/QRPGLESRC)                                 
      * DBGVIEW(*SOURCE) AUT(*ALL)                                                                  
      * CRTPGM PGM(ASNET.COM/TESTSUBR) MODULE(QTEMP/TESTSIBR ACTGRP(*NEW)                           
      *        AUT(*ALL)                                                                            
                                                                                                    
      *-------------------------------------------------------------------*                         
      *  2020/08/08 : 作成                                                                          
      *-------------------------------------------------------------------*                         
      *( 作業変数 )                                                                                 
     D MSR             S             80    DIM(1) CTDATA PERRCD(1)               配列               
     D MSG             S           3000A                                                            
     D MSGFFLIB        S             20    INZ('QCPFMSG   QSYS      ')                              
     D MSGLEN          S             10I 0                                                          
     D CALLSTK         S             10I 0 INZ(1)                                                   
     D MSGKEY          S              4A                                                            
     D AR              S              1A   DIM(256)                                                 
     D N               S              4S 0                                                          
     D NULL            S              1A   INZ(X'00')                                               
     D QMHSNDPM        C                   CONST('QSYS/QMHSNDPM')                                   
                                                                                                    
     D APIERR          DS                  QUALIFIED                                                
     D  GETBYT                 1      4B 0 INZ(160)                                                 
     D  AVLBYT                 5      8B 0 INZ(0)                                                   
     D  MSGID                  9     15                                                             
     D  MSGDTA                17    160                                                             
                                                                                                    
     C*( メイン・ルーチンの始まり )                                                                 
     C                   MOVEL     MSR(1)        MSG                                                
     C                   EXSR      SNDPGMMSG                                                        
     C                   SETON                                        LR                            
     C                   RETURN                                                                     
     C*( メイン・ルーチンの終わり )                                                                 
                                                                                                    
     C******************************************************                                        
     C     *INZSR        BEGSR                                                                      
     C******************************************************                                        
     C*  初期 CYCLE のみの実行                                                                      
     C                   ENDSR                                                                      
     C******************************************************                                        
     C     SNDPGMMSG     BEGSR                                                                      
     C******************************************************                                        
     C                   EVAL      MSG    = MSR(1)                                                  
     C                   EVAL      MSGLEN = %LEN(%TRIM(MSG))                                        
      *-------------------------------------------------------------------*                         
     C                   CALL      QMHSNDPM                                                         
     C                   PARM      'CPF9897'     MSGID             7                                
     C                   PARM                    MSGFFLIB                                           
     C                   PARM                    MSG                                                
     C                   PARM                    MSGLEN                                             
     C                   PARM      '*DIAG     '  MSGTYPE          10                                
     C                   PARM      '*PGMBDY   '  PGMQUE           10                                
     C                   PARM                    CALLSTK                                            
     C                   PARM                    MSGKEY                                             
     C                   PARM                    APIERR                                             
      *-------------------------------------------------------------------*                         
     C                   IF        APIERR.AVLBYT <> 0                                               
     C     'MSGID='      CAT       APIERR.MSGID  DSP40            40                                
     C     DSP40         DSPLY                   ANS               1                                
     C                   ENDIF                                                                      
     C                   ENDSR                                                                      
** MSR -- 以下は配列                                                                                
 これはメッセージ送信のテストです。