PGM                                                                
/*---------------------------------------------------------*/                   
/*   TESTAUT  :   ユーザー特殊権限の検査                   */                   
/*                                                         */                   
/*       API: QSYCUSRS を使ってユーザーの特殊権限を        */                   
/*            調査する。                                   */                   
/*---------------------------------------------------------*/                   
             DCL        VAR(&USER) TYPE(*CHAR) LEN(10)                          
             DCL        VAR(&TOKSHU) TYPE(*CHAR) LEN(1)                         
             DCL        VAR(&AUTSU) TYPE(*CHAR) LEN(4) +                        
                          VALUE(X'00000001')                                    
             DCL        VAR(&MSG) TYPE(*CHAR) LEN(80)                           
             DCL        VAR(&APIERR) TYPE(*CHAR) LEN(4) +                       
                          VALUE(X'00000000') /* 2 進数  */                      
             DCL        VAR(&LVL) TYPE(*CHAR) LEN(4) VALUE(X'00000001')         
             MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))                 
                                                                                
             RTVJOBA    USER(&USER)                                             
             CALL       PGM(QSYS/QSYCUSRS) PARM(&TOKSHU &USER +                 
                          '*SECADM   ' &AUTSU &LVL &APIERR)                     
             IF         COND(&TOKSHU *EQ 'N') THEN(DO)                          
             CHGVAR     VAR(&MSG) VALUE(' ユーザー ' *CAT &USER +               
                          *TCAT ' には *SECADM 権限がありません。 ')            
             GOTO       SNDMSG                                                  
             ENDDO                                                              
             RETURN                                                             
                                                                                
 ERROR:      RCVMSG     MSGTYPE(*LAST) RMV(*NO) MSG(&MSG)                       
 SNDMSG:     SNDPGMMSG  MSG(&MSG) MSGTYPE(*DIAG)                                
             ENDPGM