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