PGM                                                                
/*---------------------------------------------------------*/                   
/*   QUSLFLD   :  フィールドの一覧表                       */                   
/*                                                         */                   
/*     QUSLFLD のサンプル                                  */                   
/*                                                         */                   
/*---------------------------------------------------------*/                   
             DCL        VAR(&TYPE) TYPE(*CHAR) LEN(1)                           
             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) +                     
                          VALUE('*LIBL     ')                                   
             DCL        VAR(&MSGDTA) TYPE(*CHAR) LEN(132)                       
             DCL        VAR(&APIERR) TYPE(*CHAR) LEN(116) +                     
                          VALUE(X'000074') /* 2 進数  */                        
             DCL        VAR(&STRPOS) TYPE(*CHAR) LEN(4) +                       
                          VALUE(X'0000007D') /* 2 進数開始位置  : +             
                          125 */                                                
             DCL        VAR(&LENDTA) TYPE(*CHAR) LEN(4) +                       
                          VALUE(X'00000010') /* 2 進数受取長さ  : 16 */         
             DCL        VAR(&RCVVAR) TYPE(*CHAR) LEN(16) +                      
                          VALUE(X'0000000000000000')                            
             DCL        VAR(&OFFSET) TYPE(*CHAR) LEN(4) /* +                    
                          2 進数 dﾊlWq */                                       
             DCL        VAR(&NOENTR) TYPE(*CHAR) LEN(4) /* +                    
                          2 進数項目数  */                                      
             DCL        VAR(&LSTSIZ) TYPE(*CHAR) LEN(4) /* +                    
                          2 進数リストサイズ  */                                
             DCL        VAR(&DEC08) TYPE(*DEC) LEN(8 0) /* WORK */              
             DCL        VAR(&ADDLEN) TYPE(*DEC) LEN(8 0) /* WORK */             
             DCL        VAR(&NOENT) TYPE(*DEC) LEN(8 0) /* WORK */              
             DCL        VAR(&N) TYPE(*DEC) LEN(8 0) VALUE(1) /* WORK */         
             DCL        VAR(&RCVDTA) TYPE(*CHAR) LEN(545) /* +                  
                           受取データ  */                                       
             DCL        VAR(&NULL4) TYPE(*CHAR) LEN(4) +                        
                          VALUE(X'00000000')                                    
             MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))                 
                                                                                
             RTVJOBA    TYPE(&TYPE)                                             
/*( ユーザー・スペースの作成 )*/                                                
             CALL       PGM(QUSCRTUS) PARM('USLFLD    QTEMP     ' +             
                          'PF        ' 1000 ' ' '*ALL      ' +                  
                          'QUSLFLD 用ユーザー・スペース ' +                     
                          '*YES      ' &APIERR)                                 
             IF         COND(%SST(&APIERR 5 4) *NE &NULL4) THEN(DO)             
             GOTO       APIERR                                                  
             ENDDO                                                              
                                                                                
/*( QUSLFLD の実行 )*/                                                          
             CALL       PGM(QUSLFLD) PARM('USLFLD    QTEMP     ' +              
                          'FLDL0100' 'SHOHIN    QTRFIL    ' +                   
                          'SHOHINR   ' '0' &APIERR)                             
             IF         COND(%SST(&APIERR 5 4) *NE &NULL4) THEN(DO)             
             GOTO       APIERR                                                  
             ENDDO                                                              
                                                                                
  /*( リストデータ・セクションのオフセット値を検索 )*/                          
             CALL       PGM(QUSRTVUS) PARM('USLFLD    QTEMP     ' +             
                          &STRPOS &LENDTA &RCVVAR)                              
             CHGVAR     VAR(&OFFSET) VALUE(%SST(&RCVVAR 1 4))                   
             CHGVAR     VAR(&NOENTR) VALUE(%SST(&RCVVAR 9 4))                   
             CHGVAR     VAR(&LSTSIZ) VALUE(%SST(&RCVVAR 13 4))                  
                                                                                
         /*( RCVVAR によって OFFSET,LSTSIZ を受取った )*/                       
             CHGVAR     VAR(&STRPOS) VALUE(&OFFSET)                             
             CHGVAR     VAR(&DEC08) VALUE(%BIN(&STRPOS))                        
             CHGVAR     VAR(&DEC08) VALUE(&DEC08 + 1)                           
             CHGVAR     VAR(%BIN(&STRPOS)) VALUE(&DEC08)                        
             CHGVAR     VAR(&LENDTA) VALUE(&LSTSIZ)                             
             CHGVAR     VAR(&ADDLEN) VALUE(%BIN(&LENDTA))                       
             CHGVAR     VAR(&NOENT) VALUE(%BIN(&NOENTR))                        
NXTRTV:                                                                         
             CALL       PGM(QUSRTVUS) PARM('USLFLD    QTEMP     ' +             
                          &STRPOS &LENDTA &RCVDTA)                              
             /*( 処理の開始 )*/                                                 
             SNDPGMMSG  MSG('FLD=' *CAT %SST(&RCVDTA 1 10)) +                   
                          MSGTYPE(*DIAG)                                        
                                                                                
             /*( 処理の終了 )*/                                                 
             IF         COND(&N < &NOENT) THEN(DO)                              
             CHGVAR     VAR(&N) VALUE(&N + 1)                                   
             CHGVAR     VAR(&DEC08)  VALUE(%BIN(&STRPOS))                       
             CHGVAR     VAR(&DEC08) VALUE(&DEC08 + &ADDLEN)                     
             CHGVAR     VAR(%BIN(&STRPOS)) VALUE(&DEC08)                        
             GOTO       NXTRTV                                                  
             ENDDO                                                              
             RETURN                                                             
                                                                                
 APIERR:                                                                        
             CHGVAR     VAR(&MSGID) VALUE(%SST(&APIERR 9 7))                    
             CHGVAR     VAR(&MSGF) VALUE('QCPFMSG   ')                          
             CHGVAR     VAR(&MSGDTA) VALUE(%SST(&APIERR 17 100))                
             RTVMSG     MSGID(&MSGID) MSGF(QCPFMSG) MSGDTA(&MSGDTA) +           
                          MSG(&MSG)                                             
             GOTO       SNDMSG                                                  
 ERROR:      RCVMSG     MSGTYPE(*LAST) RMV(*NO) MSG(&MSG) +                     
                          MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +           
                          MSGFLIB(&MSGFLIB)                                     
 SNDMSG:                                                                        
             IF         COND(&TYPE *EQ '0') THEN(DO) /*  バッチ  */             
             IF         COND(&MSGID *EQ ' ') THEN(DO)                           
             SNDPGMMSG  MSG(&MSG) TOMSGQ(*SYSOPR) MSGTYPE(*COMP)                
             ENDDO                                                              
             ELSE       CMD(DO)                                                 
             SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +                    
                          MSGDTA(&MSGDTA) TOMSGQ(*SYSOPR) +                     
                          MSGTYPE(*COMP)                                        
             ENDDO                                                              
             ENDDO      /*  バッチ  */                                          
             ELSE       CMD(DO) /*  対話型  */                                  
             IF         COND(&MSGID *EQ ' ') THEN(DO)                           
             SNDPGMMSG  MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&MSG) +             
                          TOMSGQ(*TOPGMQ) MSGTYPE(*ESCAPE)                      
             ENDDO                                                              
             ELSE       CMD(DO)                                                 
             SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +                    
                          MSGDTA(&MSGDTA) TOMSGQ(*TOPGMQ) +                     
                          MSGTYPE(*ESCAPE)                                      
             ENDDO                                                              
             ENDDO      /*  対話型  */                                          
             ENDPGM