[USflag] The American Programmer [USflag]


Home
Books on Mainframe Programming
Mainframe Manuals and Tutorials
System Abend codes, Sqlcodes, VSAM/QSAM codes
Everything about the IBM AS/400 Midrange Computer - iSeries
Everything about CICS
Everything about COBOL
Everything about DB2 and SQL
Everything about IMS
Everything about Java and JavaScript
Everything about JCL and JES
Everything about REXX
  Sorting in REXX: The Bubble Sort
  REXX Password Generator
  Using REXX to capture displayed output of TSO command
  Count records in REXX
  REXX program to calculate present value of money
  REXX function to format a number in currency format
  REXX function to produce a fixed-length number
  REXX program to produce lottery numbers
  REXX: what does your phone number spell?
  REXX Practice Problems.
  Just Enough REXX Tutorial
  Setting up to Execute REXX Programs on TSO/ISPF
  How to execute a REXX program
  REXX Boolean operators
  Comparison of CLIST language and REXX
  REXX Comparison operators
  REXX Debugging: the TRACE verb
  Using REXX OUTTRAP
  Reserved REXX Variables
  Executing REXX through JCL.
  Writing ISPF Edit Macros in REXX
  REXX program to unload a PDS
  REXX book: The REXX Language on TSO
  REXX Functions Book
  QMF Procedures Written in REXX
  Using REXX Subroutines with the QMF Calc panel
  REXX error codes (RC)
  REXX programming language manuals
  Books on REXX programming
  The REXX Files
Everything about zOS, VSAM, Tivoli, Assembler
Everything about TSO, ISPF, Spufi
Site Map and Site Search

           Home   > REXX   > REXX UNLOAD LIBRARY MEMBERS TO SEQUENTIAL

REXX program to unload a PDS

You have a mainframe Partitioned Data Set and you want to copy it to a simple sequential file. You can use the sequential file as backup, or pass it through IEBUPDTE to create a copy of the original PDS.
/* REXX PDSTOSEQ
UNLOAD LIBRARY MEMBERS TO SEQUENTIAL
WITH ./ ADD NAME= COMMANDS FOR MEMBERS
execute next to library name on option 3.4
or
on ISPF command line, TSO PDSTOSEQ library-name-normal-TSO-naming-standards
type in output sequential dataset name, when prompted

LIBRARY = "REXX.EXEC"                                                  
OUTPUT_SEQUENTIAL = "UNLOAD01.DATA"                                    

*/
ARG LIBRARY OUTPUT_SEQUENTIAL  
If LIBRARY = "" then do
   Say "Please type in the name of the input PDS"
   Pull LIBRARY
   If LIBRARY = "" then exit
   end

If OUTPUT_SEQUENTIAL= "" then do
   Say "Please type in the name of the output"
   Say "sequential dataset that will hold data"
   Pull OUTPUT_SEQUENTIAL
   If OUTPUT_SEQUENTIAL = "" then exit
   end

IF SYSDSN(OUTPUT_SEQUENTIAL) = "OK" THEN DO                                     
   SAY "Reusing output " OUTPUT_SEQUENTIAL
   "ALLOC DDN(UNLOADED) OLD REUSE DSN("OUTPUT_SEQUENTIAL")"                    
   END                                                                 
ELSE DO
   SAY "Creating " OUTPUT_SEQUENTIAL
   "ALLOC DDN(UNLOADED) MOD REUSE SPACE(10,5) TRACKS",                    
      "LRECL(80) BLKSIZE(800) RECFM(F B)",                             
      "DSN("OUTPUT_SEQUENTIAL")"                                       
   END                                                                 

Say "Press ENTER to continue";pull

IF SYSDSN(LIBRARY) <> "OK" THEN DO                                     
   SAY LIBRARY "NOT USABLE"                                            
   SAY SYSDSN(LIBRARY)                                                 
   EXIT                                                                
   END    
                                                             
ADDRESS ISPEXEC "CONTROL ERRORS RETURN"                                
CALL INIT                                                              
DO 9999 /* limit for testing. change to FOREVER in real life */         
  /* EACH EXECUTION OF THIS CMD GIVES ONE MORE MEMBER NAME */          
  /* NAME OF MEMBER IS IN VARIABLE MEMNAME                 */          
  ADDRESS ISPEXEC "LMMLIST DATAID("DATAID1") OPTION(LIST)",            
                  "MEMBER(MEMNAME) STATS(YES)"                         
  /*Non-zero RC means no more members*/                                
  IF RC = 0 THEN CALL DISPLAY_MEMBER                                   
  ELSE LEAVE /* break out of loop */                                  
END       
                                                             
/* FINISHED WITH LMMLIST */                                            
ADDRESS ISPEXEC "LMMLIST  DATAID("DATAID1") OPTION(FREE)"              
/* CLOSE FILE WHEN FINISHED */                                         
ADDRESS ISPEXEC "LMCLOSE DATAID("DATAID1")"                            
/* LM STOPS ACCESSING THE FILE */                                      
ADDRESS ISPEXEC "LMFREE  DATAID("DATAID1")"                            

/* at end, write ENDUP, JCL delimiter */
SAY "writing './ ENDUP'  TO DOWNLOAD FILE"
QUEUE "./ ENDUP"
queue "!!"
queue "//"
queue "//* END \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
"EXECIO " queued() " DISKW UNLOADED (FINIS)"
"FREE DDN(DOWNLOAD)"

EXIT       /* logical end of program */
                                                            
INIT:        
/* write JCL at beginning of step */
library = translate(library," ","'") /* drop apost */
library = space(library,0) /* drop spaces */
QUEUE "//* CHANGE userid to your userid "
QUEUE "//* change library if desired"
QUEUE "//* put jobcard at top, submit"
QUEUE "//*DELETE  EXEC PGM=IEFBR14"
QUEUE "//*DD1     DD DSN="library","
QUEUE "//*        DISP=(MOD,DELETE),UNIT=SYSDA,SPACE=(TRK,0)"
QUEUE "//*"
QUEUE "//LOAD    EXEC PGM=IEBUPDTE,PARM='NEW'"
QUEUE "//SYSPRINT DD SYSOUT=*"
QUEUE "//SYSUT2  DD DSN="library","
QUEUE "//        DISP=(NEW,CATLG,DELETE),"
QUEUE "//        DCB=(DSORG=PO,LRECL=80,BLKSIZE=8000,RECFM=FB),"
QUEUE "//        UNIT=SYSDA,"
QUEUE "//        SPACE=(TRK,(10,05,20),RLSE)"
QUEUE "//*"
QUEUE "//SYSIN  DD DATA,DLM='!!'"

"EXECIO " queued() " DISKW UNLOADED (FINIS)"
                                                          
 /* LIB MGT ACCESSES THE DATASET */                                    
ADDRESS ISPEXEC "LMINIT DATAID(DATAID1) DATASET("LIBRARY") ENQ(SHR)"   
/* LIKE AN OPEN WITH REGULAR FILES */                                  
ADDRESS ISPEXEC "LMOPEN DATAID("DATAID1") OPTION(INPUT)"   
RETURN                                                     
DISPLAY_MEMBER:                                            
/*                                                         
SAY "MEMBER NAME " MEMNAME                                 
SAY "RECORDS     " ZLCNORC                                 
*/                                                         
DSN_TO_COPY = LIBRARY"("MEMNAME")"                         
DSN_TO_COPY = SPACE(DSN_TO_COPY,0)                         
                                                           
/* at beginning of each member, write blank line & ADD command */
DOT_SLASH_ADD.1 = ""                                       
"EXECIO 1 DISKW UNLOADED (STEM DOT_SLASH_ADD.)"            
DOT_SLASH_ADD.1 = "./ ADD NAME="MEMNAME                    
"EXECIO 1 DISKW UNLOADED (STEM DOT_SLASH_ADD.)"            
"FREE DDN(READMEM)"                                        
"ALLOC DDN(READMEM) SHR REUSE DSN("DSN_TO_COPY")"          
"EXECIO * DISKR READMEM (STEM READMEM. FINIS)"             
"EXECIO " READMEM.0 " DISKW UNLOADED (STEM READMEM.)"      
                                                               
/*                                                             
"REPRO INDATASET("DSN_TO_COPY")",                              
      "OUTFILE(UNLOADED)" */                                   
TRACE OFF                                                      
RETURN                                                         
ERROR: /* CALL ON ERROR SENDS HERE. DISPLAYS ISPF ERR INFO */  
SAY "PROGRAM LIBLIST DID NOT WORK"                             
SAY ZERRMSG                                                    
SAY ZERRSM                                                     
SAY ZERRLM                                                     

[Books Computer]

Home Books for Computer Professionals Privacy Terms |
Site Map and Site Search Programming Manuals and Tutorials The REXX Files Top of Page |