Friday, May 6, 2016

A rexx program to put a pds in sequential format

I use my PC as a "data store" , where i have anything on it ( Manuals, Redbooks, documents, presentations ...). And with the help of a search software (Archivarius seems to be the best search software that i've found after multiple tests) , i am able to find anything on my PC (A sort of Google search on my PC) .
So , it is interesting for me to be able to retrieve data that are on PDS from my search software.
This Rexx reads a PDS , put it in a sequential format , so i can ftp it on my PC. It provides also jcl that you can use to reload the sequential into a PDS format.

It is adapted from a Rexx that i've found on the web (unfortunately i am not able to find the first author...should be from the site of The American Programmer )



/* REXX PDS2SEQ */
/* UNLOAD PDS MEMBERS TO SEQUENTIAL */
/* WITH ./ ADD NAME= COMMANDS FOR MEMBERS */
ARG PDS outp


If PDS = "" then do
   Say "Please type in the name of the input PDS without quotes"
   Pull PDS
   If PDS = "" then exit
   end

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

outp = "'" || outp || "'"
IF SYSDSN(outp) = "OK" then
             "DELETE" outp "PURGE"

SAY "Creating " outp
"ALLOC DDN(outdd) MOD REUSE SPACE(300,150) TRACKS",
      "LRECL(80) BLKSIZE(800) RECFM(F B)",
      "DSN("outp")"

Say "Press ENTER to continue";pull

IF SYSDSN("'"pds"'") <> "OK" THEN DO
   SAY  "PDS NOT USABLE"
   SAY SYSDSN("'"pds"'")
   EXIT 8
   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 member                  */
  ADDRESS ISPEXEC "LMMLIST DATAID("DATAID1") OPTION(LIST)",
                  "MEMBER(member) STATS(YES)"
  /*Non-zero RC means no more members*/
  IF RC = 0 THEN CALL DISPLAY_MEMBER
  ELSE LEAVE /* break out of loop */
END

ADDRESS ISPEXEC "LMMLIST  DATAID("DATAID1") OPTION(FREE)"
ADDRESS ISPEXEC "LMCLOSE DATAID("DATAID1")"
ADDRESS ISPEXEC "LMFREE  DATAID("DATAID1")"

/* at end, write ENDUP, JCL delimiter */
SAY "Program successfully executed - Check your output dataset"
SAY i "members processed"
QUEUE "./ ENDUP"
queue "!!"
queue "//"
queue "//* END \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
"EXECIO " queued() " DISKW outdd (FINIS)"
"FREE DDN(outdd)"

EXIT 0     /* logical end of program */

INIT:
i=0
/* write JCL at beginning of step */
PDS = translate(PDS," ","'") /* drop apost */
PDS = space(PDS,0) /* drop spaces */
QUEUE "//* Generated by rexx PDS2SEQ     "
QUEUE "//* CHANGE userid to your userid "
QUEUE "//* change PDS if desired"
QUEUE "//* put jobcard at top, submit"
QUEUE "//*DELETE  EXEC PGM=IEFBR14"
QUEUE "//*DD1     DD DSN="PDS","
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="PDS","
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 outdd (FINIS)"

 /* LIB MGT ACCESSES THE DATASET */
ADDRESS ISPEXEC "LMINIT DATAID(DATAID1) DATASET('"PDS"') ENQ(SHR)"
/* LIKE AN OPEN WITH REGULAR FILES */
ADDRESS ISPEXEC "LMOPEN DATAID("DATAID1") OPTION(INPUT)"
RETURN

DISPLAY_MEMBER:
i=i+1
/*SAY "MEMBER NAME " member
SAY "RECORDS     " ZLCNORC */

in_pds = PDS"("member")"
in_pds = SPACE(in_pds,0)

/* at beginning of each member, write blank line & ADD command */
DOT_SLASH_ADD.1 = ""
"EXECIO 1 DISKW outdd (STEM DOT_SLASH_ADD.)"
DOT_SLASH_ADD.1 = "./ ADD NAME="member
"EXECIO 1 DISKW outdd (STEM DOT_SLASH_ADD.)"
"ALLOC DDN(indd) SHR REUSE DSN('"in_pds"')"
"EXECIO * DISKR indd (STEM indd. FINIS)"
"EXECIO " indd.0 " DISKW outdd (STEM indd.)"
if rc     <> 0 then Do
   say "**********************************************"
   say "   Error writing seq file: " rc
   say "   Abnormal end   "
   say "**********************************************"
   Exit 8
end
/*
"REPRO INDATASET("in_pds")",
      "OUTFILE(outdd)" */
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

No comments:

Post a Comment