COMPILE.JCL

//RACROUTE JOB (ACCT),                                 
//             '                    ',                 
//             CLASS=A,                                
//             MSGCLASS=X,                             
//             MSGLEVEL=(1,1),                         
//             REGION=0M,                              
//             NOTIFY=&SYSUID 
//*
//* From David Spiegel 2016
//*
//* BTW, I use an old (but little known) JCL trick ... 
//* if you notice, the SYSLIB DD has a Blank and the next 
//* card has a DD DISP= etc.  
//* This allow the user to use the DDNAME in the 
//* Cataloged Procedure and add to it.
//*
//STEP001 EXEC ASMACL                                  
//C.SYSLIB  DD                                         
//          DD DISP=SHR,DSN=SYS1.MODGEN                
//C.SYSIN   DD DISP=SHR,DSN=JCL.CNTL(RACROUTE)   
//L.SYSLMOD DD DISP=SHR,DSN=LOAD(RACROUTE)

RACCHECK.RX

/* Rexx */                                                              
/* Trace I */   
/* From David Spiegel 2016 */
/*                                                                      

   00  The user has no access.                                          
   04  The user has READ authority.                                     
   08  The user has UPDATE authority.                                   
   0C  The user has CONTROL authority.                                  
   10  The user has ALTER authority                                     
                                                                        
   https://www.ibm.com/support/knowledgecenter/en/SSLTBW_2.3.0/
   com.ibm.zos.v2r3.ichc600/ich2c6_Return_codes_and_reason_codes1.htm               

*/                                                                     
Arg dsn                                                                 
Address TSO "Call *(Racroute) '"dsn"'"                                  
Say rc

RACROUTE1

*HLASM From David Spiegel 2016
RACROUTE TITLE 'RACROUTE STATUS=ACCESS'                                 
RACROUTE CSECT ,                                                        
RACROUTE AMODE 31                                                       
RACROUTE RMODE ANY                                                      
         SAVE  (14,12),,RACROUTE.&SYSDATE..&SYSTIME Save caller's regs. 
         LR    R12,R15            Load address of entry point           
         USING RACROUTE,R12       Give assembler program's base reg.    
*                                                                       
         LR    R11,R1             Save Pointer to Parameter Address Blk 
         USING ARGS,R11                                                 
*                                                                       
         GETMAIN R,LV=SAVESIZE,LOC=BELOW  Get storage to put DCB in     
         XC    0(CLEARSIZ,R1),0(R1)  Clear the save/work area           
         ST    R1,8(,R13)         Save new save area addr.in old area   
         ST    R13,4(,R1)         Save old save area addr.in new area   
         LR    R13,R1             Replace old save area with new one    
         USING SAVEAREA,R13       Tell assembler about save area        
*                                                                       
*                                                                       
*                                                                       
         L     R11,0(R11)                                               
         LH    R5,0(R11)                                                
         C     R5,=F'0'           PARM?                                 
         BE    RETURN             No, RETURN                            
*                                                                       
         BCTR  R5,0                                                     
         EX    R5,MVC                                                   
         B     CONTINUE                                                 
*                                                                       
MVC      MVC   THEENT(*-*),2(R11)                                       
*                                                                       
*                                                                       
*                                                                       
CONTINUE DS    0F                                                       
         RACROUTE REQUEST=AUTH,                                        x
               RELEASE=1.9,                                            x
               STATUS=ACCESS,                                          x
               CLASS='DATASET',                                        x
               ATTR=UPDATE,                                            x
               ENTITY=THEENT,VOLSER=THEVOL,                            x
               WORKA=SAFWORKA                                           
         LM    R3,R4,CONTINUE+4      Save Return Code, Reason Code      
*                                                                       
*                                                                       
*                                                                       
RETURN   DS    0H                                                       
*        WTO   'RACROUTE About to Exit'                                 
         LR    R1,R13             Save old save area addr. for FREEMAIN 
         L     R13,4(,R13)        Restore old save area address         
         FREEMAIN R,LV=SAVESIZE,A=(1)  Release save and DCB storage     
EXIT     DS    0H                                                       
         LR    R15,R4             Return with Reason Code               
*        SLR   R15,R15            Set a return code of zero             
         RETURN (14,12),RC=(15)   Return to caller, return code zero    
*                                                                       
*                                                                       
*                                                                       
         DS    0D                                                       
SAFWORKA DS    CL512                                                    
THEENT   DC    CL44'TTSDS.*'                                            
THEVOL   DC    CL6'THEVOL'                                              
*                                                                       
*                                                                       
*                                                                       
SAVEAREA DSECT ,                  Register save area and work area      
         DS    18F                Register save area                    
CLEARSIZ EQU   *-SAVEAREA         Save and work area size               
RECORD   DS    0CL16                                                    
USERID   DS    CL8                                                      
PASSWORD DS    CL8                                                      
RECSIZE  EQU   *-RECORD                                                 
WTO0     WTO   '                                                     ',X
               MF=L                                                     
WTO0L    EQU   *-WTO0                                                   
SAVESIZE EQU   *-SAVEAREA         Save and work area size               
*                                                                       
*                                                                       
*                                                                       
ARGS     DSECT                                                          
         DS    0D                                                       
LENGTH   DS    H                                                        
DSNAME   DS    CL44               Dataset Name to Check                 
         YREGS                                                          
         END