/* rexx */                                                                      
/*-------------------------------------------------------------------*/         
/*                                                                   */         
/*                         REXX Exec : ASLDBACT                      */         
/*                                                                   */         
/*  Description : Displays the DB subsystems defined on the LPAR and */         
/*                the status of them (A) Active (I) Inactive         */         
/*                                                                   */         
/*  Created on : 4 Apr 2018                                          */         
/*  Created by : Kevin Ferguson                                      */         
/*             : Userid(MIT001)                                      */         
/*             : using ABBYDALE.XFER.REXX(ASLDBACT)                  */         
/*                                                                   */         
/*  Called by :                                                      */         
/*                                                                   */         
/*  Calls : get_ptr, get_data (instream)                             */         
/*                                                                   */         
/*  Change Activity :                                                */         
/*                                                                   */         
/*                ©Copyright of Abbydale Systems LLC.                */         
/*                                                                   */         
/*-------------------------------------------------------------------*/         
signal on halt                      /* attention key      */                    
numeric digits 10                                                               
cvt_ptr = get_ptr(10,)              /* CVT pointer            */                
cvtjesct = get_ptr(cvt_ptr,'128')   /* address of CVTJESCT    */                
ssct_ptr = get_ptr(cvtjesct,'18')   /* address of SSCT        */                
Block_id = get_data(ssct_ptr,'0',4) /* Block_id must = 'SSCT' */                
done = 'n'                                                                      
cc = 0                                                                          
temp = ""                                                                       
do until done = 'y'                                                             
    if Block_id = 'SSCT' then do                                                
       taskname = get_data(ssct_ptr,'8',4)                                      
       SSCTSUSE_ptr = get_ptr(ssct_ptr,'14')                                    
       ssct_anc = get_ptr(cvtjesct,'18')                                        
       if ssctsuse_ptr = '0' then do                                            
          ssct_ptr = get_ptr(ssct_ptr,'4')                                      
       end                                                                      
       else do                                                                  
          if SSCTSUSE_ptr < '80000000' then do                                  
             Early = get_data(SSCTSUSE_ptr,'4',4)                               
             if early = 'ERLY' then do                                          
                Program = get_data(SSCTSUSE_ptr,'54',7)                         
                if Program = 'DSN3EPX' then do                                  
                   run = get_ptr(ssct_ptr,'10',4)                               
                   run = get_ptr(run,'4',4)                                     
                   st = "(A)"                                                   
                   if run = '0' then do                                         
                      st = "(I)"                                                
                   end                                                          
                   temp = temp||SUBSTR(taskname,1,4)||st||","                   
                end                                                             
             end                                                                
          end                                                                   
          ssct_ptr = get_ptr(ssct_ptr,'4')                                      
       end                                                                      
       if ssct_ptr = '0' then do                                                
       done = 'y'                                                               
       end                                                                      
 end                                                                            
 else do                                                                        
    Say 'Logic error ' block_id 'found where SSCT should be'                    
    cc = 16                                                                     
    done = 'y'                                                                  
 end                                                                            
end                                                                             
ASLACTDB = substr(temp,1,LENGTH(temp)-1)                                        
"ISPEXEC VPUT (ASLACTDB) PROFILE"                                               
exit (cc)                                                                       
/*-------------------------------------------------------------------*/         
/*                         End of main line                          */         
/*-------------------------------------------------------------------*/         
/*                         get_ptr Subroutine                        */         
/*-------------------------------------------------------------------*/         
/* Returns a 4 byte pointer as hexadecimal string at address         */         
/* ADDR+OFFSET (ADDR and OFFSET must be hex strings.)                */         
/*-------------------------------------------------------------------*/         
get_ptr: procedure                                                              
 arg addr,offset                                                                
temp=d2x(x2d(addr)+x2d(offset))                                                 
return c2x(storage(temp,4))                                                     
exit                                                                            
/*-------------------------------------------------------------------*/         
/*                    End of get_ptr Subroutine                      */         
/*-------------------------------------------------------------------*/         
/*                        get_date Subroutine                        */         
/*-------------------------------------------------------------------*/         
/* Returns LENGTH bytes at ADDR+OFFSET as an EBCDIC string.          */         
/* (ADDR and OFFSET must be hex strings). LENGTH must be a decimal   */         
/* string.                                                           */         
/*-------------------------------------------------------------------*/         
get_data: procedure                                                             
arg addr,offset,length                                                          
temp=d2x(x2d(addr)+x2d(offset))                                                 
return storage(temp,length)                                                     
exit                                                                            
/*-------------------------------------------------------------------*/         
/*                   End of get_data Subroutine                      */         
/*-------------------------------------------------------------------*/         
/*                        Trap HALT Condition                        */         
/*-------------------------------------------------------------------*/         
halt:                                                                           
say "HALT acknowledged in line" sigl                                            
say "Cleanup processing in progress"                                            
address "TSO"                                                                   
"delstack"                                                                      
exit(16)                                                                        
/*-------------------------------------------------------------------*/         
/*                           End of ASLDBACT                         */         
/*-------------------------------------------------------------------*/