PGM        PARM(&DIR)                                              
/*---------------------------------------------------------*/                   
/*     CHKIFS :  IFS 検査                                  */                   
/*---------------------------------------------------------*/                   
             DCL        VAR(&MSG) TYPE(*CHAR) LEN(80)                           
             DCL        VAR(&DIR) TYPE(*CHAR) LEN(256)                          
             DCL        VAR(&FILDES) TYPE(*INT)                                 
             DCL        VAR(&OFLAG) TYPE(*INT)                                  
             DCL        VAR(&O_RDONLY) TYPE(*INT) VALUE(1)                      
             DCL        VAR(&O_SHR_NONE) TYPE(*INT) VALUE(524288)               
             DCL        VAR(&NULL) TYPE(*CHAR) LEN(1) VALUE(X'00')              
             DCL        VAR(&FALSE) TYPE(*INT) VALUE(-1)                        
             MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))                 
                                                                                
             CHGVAR     VAR(&DIR) VALUE(&DIR *TCAT &NULL)                       
             MONMSG     MSGID(MCH3601) EXEC(GOTO CMDLBL(ERROR))                 
             CHGVAR     VAR(&OFLAG) VALUE(&O_RDONLY + &O_SHR_NONE)              
             CALLPRC    PRC('open') PARM((&DIR) (&OFLAG *BYVAL)) +              
                          RTNVAL(&FILDES)                                       
             IF         COND(&FILDES *EQ &FALSE) THEN(DO) /*  失敗  */          
             SNDPGMMSG  MSGID(CPF9897) MSGF(QCPFMSG) +                          
                          MSGDTA(' ファイル ' *CAT &DIR *TCAT +                 
                          ' は見つかりません。 ') MSGTYPE(*ESCAPE)              
             ENDDO      /*  失敗  */                                            
             ELSE       CMD(DO) /*  成功  */                                    
             CALLPRC    PRC('close') PARM((&FILDES *BYVAL))                     
             RETURN                                                             
             ENDDO      /*  成功  */                                            
                                                                                
 ERROR:      RCVMSG     MSGTYPE(*LAST) RMV(*NO) MSG(&MSG)                       
 SNDMSG:     SNDPGMMSG  MSG(&MSG) MSGTYPE(*DIAG)                                
             ENDPGM