/* REXX */
/********************************************************************/
/*   REXX STARTED FROM &sysuid..USER.CLIST(UCOPY)                  **/
/* AUTOR: B. BRUECKMANN 28/09/95                                   **/
/*   DOC: COPY OF a DATASET                                        **/
/*   SYNTAX: UCOPY OLDDSN NEWDSN                                   **/
/*  SYNTAX: UCOPY OLDDSN NEWDSN                                    **/
/*          UCOPY X9E0236.TEST.XX X9E0236.TEST.YY                  **/
/*    OR                                                           **/
/*          UCOPY DSN_MIT_WILDCARD OLDSTRING NEWSTRING             **/
/*          UCOPY X9E0236.TEST.*  X9E0236 X9E0240                  **/
/********************************************************************/
TRACE off
PARSE ARG DSN P1 P2 .
DSYSIN="'"SYSVAR(SYSUID).SYSIN"'"
"CLEAR"
DSN=STRIP(DSN,B,'''')
P1=STRIP(P1,B,'''')
P2=STRIP(P2,B,'''')
IF DSN='' THEN CALL ERR
K=0
A=INDEX(DSN,"*")-1   /* POSITION * */
IF A>0 & P2='' THEN CALL ERR
/*IF A<0 THEN A=LENGTH(DSN) */
DO I=A TO 1 BY -1
 IF SUBSTR(DSN,I,1)='.' THEN DO
   K=I-1
   I=1
 END
END
IF A>=0 THEN DO
 IF I<1 THEN I=LENGTH(DSN) /* NUR DER FIRSTLEVEL ANGEGEBEN */
 IF A=0 THEN
   FLQ=P1   /* DER FIRST LEVEL QUALIFIER IST * ES WIRD DURCH P1 ERS.*/
 ELSE
  FLQ=SUBSTR(DSN,1,K)
 X=OUTTRAP(FIELD.)
 ADDRESS TSO "LISTC LEVEL('"FLQ"')"
 X=OUTTRAP(OFF)
 N=0
 DO I=1 TO FIELD.0
  IF INDEX(FIELD.I,"IN-CAT")=0 & POS(P1,FIELD.I)>0 THEN DO
    N=N+1
    DATA="DSNS."N"=SPACE(SUBSTR(FIELD.I,17),0)"
    INTERPRET DATA
  END
 END
 DSNZ=SUBSTR(DSN,1,A)
 K=0
 DO I=1 TO N
  DSND.I=''
  IF SUBSTR(DSNS.I,1,A)=DSNZ THEN DO
   P=POS(P1,DSNS.I)
   DSND.I=DELSTR(DSNS.I,P,LENGTH(P1))
   DSND.I=INSERT(P2,DSND.I,P-1)
   K=K+1
   DSNS.0=I
   DSND.0=I
  END
 END
END
ELSE DO
 DSNS.0=1
 DSNS.1=DSN
 IF P1="" THEN DO
  SAY "COPY OLDDATASET"
  SAY DSNS.1
  SAY "TO "
  PULL P1
 END
 DSND.0=1
 DSND.1=space(P1,0)
END
IF DSNS.0 >0 THEN
  DO I=1 TO DSNS.0
   IF DSND.I<>'' THEN
    CALL COPY DSNS.I DSND.I
  END
ELSE DO
 SAY "DATASET "DSN" MIT STRING "P1" NICHT GEFUNDEN"
END
EXIT
COPY:
PARSE ARG DSNN DSNT
DSNN="'"DSNN"'"
DSNT="'"DSNT"'"
X=LISTDSI(DSNN)
IF X>0 THEN DO
 SAY 'ERROR ' X 'IN LISTDSI FOR DSN='DSN
 if x>4 then exit 8
 SAY 'SOME INFORMATION NOT FOUND'
END
SAY "COPY FROM " DSNN " TO " DSNT
SAY "DSORG = " SYSDSORG
IF SUBSTR(SYSDSORG,1,2)='PO' THEN DO
 DUMMY=MSG(OFF)
 "DELETE "dsYSIN
 DUMMY=MSG(ON)
 "ALLOC FILE (IN) DSN("DSNN") SHR"
 IF SYSDSN(DSNT) <> 'OK' THEN
  "ALLOC FILE (OUT) DSN("DSNT") NEW CATALOG LIKE("DSNN")"
 ELSE
  "ALLOC FILE (OUT) DSN("DSNT") SHR"
 "ALLOC FILE (SYSUT4) UNIT(SYSDA) SPACE(1,1) CYLINDERS NEW"
 "ALLOC FILE(TEMP) DA ("DSYSIN") NEW SPACE(1,1) LRECL(80) BLKSIZE(80)
  CATALOG"
 TEMP1=" COPY INDD=IN,OUTDD=OUT"
 "EXECIO 1 DISKW TEMP (STEM TEMP FINIS"
 "FREE FI(TEMP)"
 "FREE FI(SYSIN)"
 "ALLOC FILE(SYSIN) DA ("DSYSIN") SHR"
 "ALLOC FILE(SYSPRINT) DA(*)"
 /* CALL IEBCOPY TO COPY PROFILE                    */
 "CALL 'SYS1.LINKLIB(IEBCOPY)'"
 RC = LASTCC
 IF RC='' THEN RC=0
 SAY "... COMPLETED IEBCOPY, RETURN CODE = " RC
 IF RC=8 THEN
   SAY ".. RETURN CODE 8 -- SEVERE ERROR - CHECK THE IEBCOPY SYSPRINT"
 IF RC = 4 THEN
  SAY ".. RETURN CODE 4 -- MEMBERS ARE POSSIBLY MISSING - CHECK THE
  IEBCOPY SYSPRINT"
 "FREE FILE (IN,OUT,SYSUT3,SYSUT4,SYSIN,SYSPRINT)"
 "ALLOC FI(SYSIN) DA(*)"
 DUMMY=MSG(OFF)
 "DELETE "dSYSIN
 DUMMY=MSG(ON)
END
IF SUBSTR(SYSDSORG,1,2)='PS' THEN DO
 /* PS DATASET */
/* SMC HAT FEHLER BEI DATEIEN MIT UNGERADEN SATZLAENGE DAHER IEBGENER*/
 /*"SMC FROMDATASET("DSNN") TODATASET("DSNT")"*/
 "ALLOC FILE (SYSUT1) DSN("DSNN") SHR"
 IF SYSDSN(DSNT) <> 'OK' THEN
  "ALLOC FILE (SYSUT2) DSN("DSNT") NEW CATALOG LIKE("DSNN")"
 ELSE
  "ALLOC FILE (SYSUT2) DSN("DSNT") SHR"
 "ALLOC FILE (SYSUT4) UNIT(SYSDA) SPACE(1,1) CYLINDERS NEW"
 "FREE  FILE(SYSIN)"
 "ALLOC FILE(SYSIN)  DUMMY"
 "ALLOC FILE(SYSPRINT) DA(*)"
 "CALL 'SYS1.LINKLIB(IEBGENER)'"
 RC = LASTCC
 IF RC='' THEN RC=0
 SAY "... COMPLETED IEBGENER RETURN CODE = "RC
 IF RC=8 THEN
   SAY ".. RETURN CODE 8 -- SEVERE ERROR - CHECK THE IEBGENER SYSPRINT"
 IF RC = 4 THEN
  SAY ".. RETURN CODE 4 -- MEMBERS ARE POSSIBLY MISSING - CHECK THE
  IEBGENER SYSPRINT"
 "FREE FILE (SYSUT1,SYSUT2,SYSUT4,SYSIN)"
 "ALLOC FI(SYSIN) DA(*)"
END
IF SUBSTR(SYSDSORG,1,2)='VS' THEN DO
 IF SYSDSN(DSNT) <> 'OK' THEN do
   SAY "DATASET "DSNT" NOT FOUND"
   exit 8
  end
 DUMMY=MSG(OFF)
 "DELETE "dSYSIN
 DUMMY=MSG(ON)
 "ALLOC FILE(TEMP) DA ("dSYSIN") NEW SPACE(1,1) LRECL(80) BLKSIZE(80)
  CATALOG"
 TEMP1=" REPRO IDS("DSNN") ODS("DSNT")"
 "EXECIO 1 DISKW TEMP (STEM TEMP FINIS"
 "FREE FI(TEMP)"
 "FREE FI(SYSIN)"
 "ALLOC FILE(SYSIN) DA ("dSYSIN") SHR"
 "ALLOC FILE(SYSPRINT) DA(*)"
 /* CALL IEBCOPY TO COPY PROFILE                    */
 "CALL 'SYS1.LINKLIB(IDCAMS)'"
 IF RC='' THEN RC=0
 SAY "... COMPLETED Idcams, RETURN CODE = " RC
 IF RC=8 THEN
   SAY ".. RETURN CODE 8 -- SEVERE ERROR - CHECK THE idcams SYSPRINT"
 "FREE FILE (SYSIN,SYSPRINT)"
 "ALLOC FI(SYSIN) DA(*)"
 DUMMY=MSG(OFF)
 "DELETE "dSYSIN
 DUMMY=MSG(ON)
END
RETURN
ERR:
 SAY "SYNTAX: UCOPY DATASETNAME-OLD DATASETNAME-NEW"
 SAY "ODER    UCOPY DATASETNAME-OLD.* OLDSTRING NEWSTRING"
 SAY "BSP.: UCOPY X9E0236.TEST.XX X9E0237.TEST.XX "
 SAY "ODER  UCOPY X9E0236.TEST.* X9E0237 X9E0240"
 SAY "      ES WIRD DER OLDTRING DURCH DEN NEWSTRING IM DATASETNAME"
 SAY "      NACH DER ERSETZUNG VON * ERSETZT"
 EXIT
EXIT