/***********************REXX*******************************************/
/*  FUNCTION : THIS copies all the data from the members of a PDS file*/
/*             into a PS file, which need not to exist                */
/*  WRITTEN BY GOPINATHAN BALASUBRAMANIAN ON 03/03/2003               */
/**********************************************************************/
TRACE OFF                                                               
INPREC. = " "                                                           
I=OUTTRAP("INPREC.")                                                    
SAY 'ENTER THE PDS NAME'                                                
PULL PDSDSN                                                             
"LISTDS " PDSDSN                                                        
IF ( WORD(INPREC.1,1) \= (USERID() ||"."|| PDSDSN)) | ,                 
      (WORD(INPREC.3,4) \= 'PO') THEN                                   
  do                                                                    
    SAY " INVALID PDS NAME, THIS PDS DOESNOT EXIST"                     
    exit                                                                
  end                                                                   
ELSE                                                                    
  NOP                                                                   
INPREC. = " "                                                           
I=OUTTRAP("INPREC.")                                                    
SAY 'ENTER THE PS NAME'                                                 
PULL PSDSN                                                              
"LISTDS " PSDSN                                                         
IF WORD(INPREC.1 , 1) \= (USERID() ||"."|| PSDSN) THEN                  
DO                                                                      
say "New PS file Created ..."                                           
"ALLOC FILE(PSFILE) DATASET(" || PSDSN||") NEW DSORG(PS) LIKE("PDSDSN")"
END                                                                     
ELSE                                                                    
  DO                                                                    
   IF (WORD(INPREC.3,4) \= 'PS') THEN                                   
     do                                                                 
     SAY "NOT A PS FILE"                                                
     exit                                                               
     end                                                                
   ELSE                                                                 
     NOP                                                                
 "ALLOC FILE(PSFILE) DATASET(" || PSDSN||") SHR "                       
  END                                                                   
INPREC. = " "                                                           
I=OUTTRAP("INPREC.")                                                    
"LISTDS" PDSDSN "MEMBERS"                                               
EXTRACT = 0                                                             
j = 1;                                                                  
memlist. = " "                                                          
DO I=1 TO INPREC.0                                                      
 IF INPREC.I = "--MEMBERS--"                                            
  THEN EXTRACT = 1;                                                     
  ELSE                                                                  
    DO                                                                  
    IF INPREC.I = "READY" THEN                                          
       EXTRACT = 0                                                      
    ELSE                                                                
       NOP                                                              
  END                                                                   
 IF EXTRACT = 1 & INPREC.I \= "--MEMBERS--"THEN                         
  do                                                                    
   memlist.j = SUBSTR(INPREC.I,3,8)                                     
   j = j +1                                                             
  end                                                                   
 ELSE                                                                   
   NOP                                                                  
END;                                                                    
memlist.0 = j - 1                                                       
no = 0                                                                  
 say "Input pds file " userid()||"."||pdsdsn                            
 say "Member names"                                                     
do a = 1 to memlist.0                                                   
 "alloc da("||pdsdsn|| "("||strip(memlist.a,'t')||,                     
 ")) fi(infile) shr "                                                   
 "execio * diskr infile (stem inrec. FINIS"                             
 say memlist.a                                                          
 no = no + inrec.0                                                      
 "execio "inrec.0 "diskw psfile (stem inrec."                           
 inrec. = " "                                                           
 "free fiLE(infile)"                                                    
end                                                                     
"execio 0 diskw psfile (finis"                                          
"FREE FILE(PSFILE)"                                                     
say "Totally " no "lines written into " userid()||"."||psdsn                
/**********************************************************************/  
/********************END OF THE REXX PRGRAM****************************/
/**********************************************************************/  
                                                            
Back to Index