PGM                                                                
/*---------------------------------------------------------*/                   
/*   TESTDCX  :  QDCXLATE のテスト                         */                   
/*                                                         */                   
/*   CRTCLPGM MYLIB/TESTDCX SRCFILE(MYSRCLIB/QCLSRC)       */                   
/*   AUT(*ALL)                                             */                   
/*---------------------------------------------------------*/                   
             DCL        VAR(&MSG) TYPE(*CHAR) LEN(80)                           
             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(&EBCBUF) TYPE(*CHAR) LEN(5000)                      
             DCL        VAR(&EBCLEN) TYPE(*CHAR) LEN(3) +                       
                          VALUE(X'00006F') /* 5 桁 PACK */                      
             DCL        VAR(&ASCBUF) TYPE(*CHAR) LEN(5000)                      
             DCL        VAR(&ASCLEN) TYPE(*CHAR) LEN(3) +                       
                          VALUE(X'05000F') /* 5 桁 PACK */                      
             DCL        VAR(&MAXOTL) TYPE(*CHAR) LEN(3) +                       
                          VALUE(X'05000F') /* 5 桁の PACK 形式  +               
                           変換用 */                                            
             MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))                 
                                                                                
             RTVJOBA    TYPE(&TYPE)                                             
             CHGVAR     VAR(&EBCBUF) VALUE('ABC123')                            
             CALL       PGM(QDCXLATE) PARM(&EBCLEN &EBCBUF 'QASCII  +           
                          ' 'QSYS    ' &ASCBUF &MAXOTL &ASCLEN +                
                          '*JPN ' 'N' '*EA ')                                   
             SNDPGMMSG  MSG(&EBCBUF *TCAT +                                     
                          ' を ASCII に変換しました。 ') MSGTYPE(*DIAG)         
             RETURN                                                             
                                                                                
 ERROR:      RCVMSG     MSGTYPE(*LAST) RMV(*NO) MSG(&MSG) +                     
                          MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +           
                          MSGFLIB(&MSGFLIB)                                     
 SNDMSG:                                                                        
             IF         COND(&TYPE *EQ '0') THEN(DO)                            
             SNDPGMMSG  MSG(&MSG) TOMSGQ(*TOPGMQ) MSGTYPE(*COMP)                
             ENDDO                                                              
             ELSE       CMD(DO)                                                 
             IF         COND(&MSGID *EQ ' ') THEN(DO)                           
             SNDPGMMSG  MSG(&MSG) TOMSGQ(*TOPGMQ) MSGTYPE(*DIAG)                
             ENDDO                                                              
             ELSE       CMD(DO)                                                 
             SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +                    
                          MSGDTA(&MSGDTA) TOMSGQ(*TOPGMQ) +                     
                          MSGTYPE(*ESCAPE)                                      
             ENDDO                                                              
             ENDDO                                                              
             ENDPGM