PGM        PARM(&CMDNAME  &STRING)                                 
/*------------------------------------------------------------------------*/    
/*   AA4_SAMPLE :  プロンプト一時変更プログラム                           */    
/*               -- このプログラムはコマンドの初期値を設定します。        */    
/*                  &STRING に長さとパラメータの初期値を戻します。        */    
/*                                                                        */    
/*   2019/12/01  作成                                                     */    
/*------------------------------------------------------------------------*/    
             DCL        VAR(&CMDNAME) TYPE(*CHAR) LEN(20)                       
             DCL        VAR(&STRING)  TYPE(*CHAR) LEN(5700)                     
             DCL        VAR(&STRINGLEN) TYPE(*DEC) LEN(8 0) VALUE(1024)         
             DCL        VAR(&BIN2) TYPE(*CHAR) LEN(2) VALUE(X'0400') +          
                          /*  長さ 1024 バイト  */                              
             DCL        VAR(&BIN4) TYPE(*CHAR) LEN(4)                           
             DCL        VAR(&MSG) TYPE(*CHAR) LEN(132)                          
             DCL        VAR(&MSGID) TYPE(*CHAR) LEN(7)                          
             DCL        VAR(&MSGF) TYPE(*CHAR) LEN(10)                          
             DCL        VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)                       
             DCL        VAR(&MSGDTA) TYPE(*CHAR) LEN(132)                       
             DCL        VAR(&TYPE) TYPE(*CHAR) LEN(1)                           
             DCL        VAR(&TOPGMQ) TYPE(*CHAR) LEN(10)                        
             DCL        VAR(&MSGTYPE) TYPE(*CHAR) LEN(10) +                     
                          VALUE('*ESCAPE   ')                                   
             DCL        VAR(&APIERR) TYPE(*CHAR) LEN(116) +                     
                          VALUE(X'00000074') /* 2 進数  */                      
             DCL        VAR(&NULL4) TYPE(*CHAR) LEN(4) +                        
                          VALUE(X'00000000')                                    
             /*--------------------------------------------------*/             
             /*   以下は装置の初期値パラメータ                   */             
             /*--------------------------------------------------*/             
             DCL        VAR(&DEV_) TYPE(*CHAR) LEN(10)                          
             /*--------------------------------------------------*/             
             /*   以下は返信パラメータ                           */             
             /*--------------------------------------------------*/             
             DCL        VAR(&DEV)    TYPE(*CHAR) LEN(40) +                      
                          VALUE(' ??DEV(')                                      
             MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))                 
                                                                                
/*( 環境の取得 )*/                                                              
             RTVJOBA    TYPE(&TYPE)                                             
             IF         COND(&TYPE *EQ '0') THEN(DO) /*  バッチ  */             
             CHGVAR     VAR(&TOPGMQ) VALUE('*SYSOPR   ')                        
             ENDDO      /*  バッチ  */                                          
             ELSE       CMD(DO) /*  対話式  */                                  
             CHGVAR     VAR(&TOPGMQ) VALUE('*TOPGMQ   ')                        
             ENDDO      /*  対話式  */                                          
                                                                                
/*      ************************************************    */                  
/*                  返信パラメータの作成                    */                  
/*      ************************************************    */                  
             CHGVAR     VAR(&DEV) VALUE(&DEV *TCAT &WTR *TCAT ')')              
/*      ************************************************    */                  
/*                  返信ストリングの作成                    */                  
/*      ************************************************    */                  
             CHGVAR     VAR(&STRING) VALUE(&BIN2) /*  長さ  */                  
             CHGVAR     VAR(&STRING) VALUE(&STRING *TCAT &DEV)                  
             RETURN                                                             
                                                                                
ERROR:       /*( エラーがあったときは CPF0011 を *ESCAPE で戻す )*/             
             RCVMSG     RMV(*NO) MSG(&MSG)                                      
             SNDPGMMSG  MSG(&MSG) MSGTYPE(*DIAG)                                
             SNDPGMMSG  MSGID(CPF0011) MSGF(QCPFMSG) MSGTYPE(*ESCAPE)           
             ENDPGM