PGM                                                                
/*-------------------------------------------------------------------*/         
/*   AB1_SAMPLE :  OUTQ 設定のデータ待ち行列の読取り                 */         
/*                                                                   */         
/*   2021/05/30  作成                                                */         
/*-------------------------------------------------------------------*/         
             DCL        VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)                       
             DCL        VAR(&MSG) TYPE(*CHAR) LEN(132)                          
             DCL        VAR(&STMMSG) 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(&MSGKEY) TYPE(*CHAR) LEN(4)                         
             DCL        VAR(&MSGDTA) TYPE(*CHAR) LEN(132)                       
             DCL        VAR(&ERRDTA) 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(&ERR) TYPE(*CHAR) LEN(1)                            
             DCL        VAR(&NULL4) TYPE(*CHAR) LEN(4) +                        
                          VALUE(X'00000000')                                    
/*( QRCVDTAQ の変数 )*/                                                         
             DCL        VAR(&RCVDTA) TYPE(*CHAR) LEN(128)                       
             DCL        VAR(&RCVLEN) TYPE(*DEC) LEN(5 0) VALUE(128)             
             DCL        VAR(&WAIT) TYPE(*DEC) LEN(5 0) VALUE(0)                 
/*( DTAQ 情報 )*/                                                               
             DCL        VAR(&JOB) TYPE(*CHAR) LEN(10)                           
             DCL        VAR(&USER) TYPE(*CHAR) LEN(10)                          
             DCL        VAR(&JOBNBR) TYPE(*CHAR) LEN(6)                         
             DCL        VAR(&SPLF) TYPE(*CHAR) LEN(10)                          
             DCL        VAR(&SPLNB) TYPE(*CHAR) LEN(4)                          
             DCL        VAR(&SPLNO) TYPE(*DEC) LEN(6 0)                         
             DCL        VAR(&SPLNOC) TYPE(*CHAR) LEN(6)                         
             DCL        VAR(&OUTQ) TYPE(*CHAR) LEN(10)                          
             DCL        VAR(&OUTQLIB) TYPE(*CHAR) LEN(10)                       
             DCL        VAR(&SYSTEM) TYPE(*CHAR) LEN(8)                         
             MONMSG     MSGID(CPF9999) 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      /*  対話式  */                                          
                                                                                
/*( 待ち行列 DTAQ からのデータ取得 )*/                                          
 READ:       CALL       PGM(QRCVDTAQ) PARM('MYDTAQ    ' 'QTEMP     ' +          
                          &RCVLEN &RCVDTA &WAIT)                                
             IF         COND(&RCVLEN *EQ 0) THEN(GOTO CMDLBL(REDEND))           
             CHGVAR     VAR(&JOB) VALUE(%SST(&RCVDTA 13 10))                    
             CHGVAR     VAR(&USER) VALUE(%SST(&RCVDTA 23 10))                   
             CHGVAR     VAR(&JOBNBR) VALUE(%SST(&RCVDTA 33 6))                  
             CHGVAR     VAR(&SPLF) VALUE(%SST(&RCVDTA 39 10))                   
             CHGVAR     VAR(&SPLNB) VALUE(%SST(&RCVDTA 49 4))                   
             CHGVAR     VAR(&SPLNO) VALUE(%BIN(&SPLNB))                         
             CHGVAR     VAR(&SPLNOC) VALUE(&SPLNO)                              
             CHGVAR     VAR(&OUTQ) VALUE(%SST(&RCVDTA 53 10))                   
             CHGVAR     VAR(&OUTQLIB) VALUE(%SST(&RCVDTA 63 10))                
             CHGVAR     VAR(&SYSTEM) VALUE(%SST(&RCVDTA 73 8))                  
             /*************************/                                        
             /* 処理の開始 - ここから */                                        
             /*************************/                                        
             /*************************/                                        
             /* 処理の開始 - ここまで */                                        
             /*************************/                                        
             GOTO       READ                                                    
 REDEND:     RETURN                                                             
                                                                                
 APIERR:                                                                        
             CHGVAR     VAR(&MSGID) VALUE(%SST(&APIERR 9 7))                    
             CHGVAR     VAR(&MSGDTA) VALUE(%SST(&APIERR 17 100))                
             CHGVAR     VAR(&MSGF) VALUE('QCPFMSG   ')                          
             CHGVAR     VAR(&MSGFLIB) VALUE('QSYS      ')                       
             GOTO       SNDMSG                                                  
                                                                                
 ERROR:      RCVMSG     MSGTYPE(*LAST) RMV(*NO) KEYVAR(&MSGKEY) +               
                          MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +           
                          MSGFLIB(&MSGFLIB)                                     
             IF         COND(&MSGID *EQ 'CPF9999') THEN(DO)                     
             CHGVAR     VAR(&ERRDTA) VALUE(&MSGDTA)                             
             RCVMSG     MSGTYPE(*PRV) MSGKEY(&MSGKEY) RMV(*NO) +                
                          MSG(&MSG) MSGDTA(&MSGDTA) MSGID(&MSGID) +             
                          MSGF(&MSGF) MSGFLIB(&MSGFLIB)                         
             CHGVAR     VAR(&STMMSG) VALUE(' プログラム ' *CAT +                
                          %SST(&ERRDTA 8 10) *TCAT +                            
                          ' のステートメント ' *CAT %SST(&ERRDTA +              
                          24 4) *CAT ' で次のエラーが発生しました。 ')          
             SNDPGMMSG  MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&STMMSG) +          
                          TOMSGQ(&TOPGMQ) MSGTYPE(*DIAG)                        
             ENDDO                                                              
 SNDMSG:     IF         COND(&MSGID *EQ ' ') THEN(DO)                           
             SNDPGMMSG  MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&MSG) +             
                          TOMSGQ(&TOPGMQ) MSGTYPE(&MSGTYPE)                     
             MONMSG     MSGID(CPF2400) EXEC(RETURN)                             
             ENDDO                                                              
             ELSE       CMD(DO)                                                 
             SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +                    
                          MSGDTA(&MSGDTA) TOMSGQ(&TOPGMQ) +                     
                          MSGTYPE(&MSGTYPE)                                     
             MONMSG     MSGID(CPF2400) EXEC(RETURN)                             
             ENDDO                                                              
             ENDPGM