00010008PROC 1 DSNAME SHR OLD LIST NOLIST PRINT(*) VOLUME() UNIT()
00011010IF &SHR ^= SHR THEN SET OLD = OLD
00020007CONTROL PROMPT,NOMSG
00030009IF &VOLUME ^= THEN DO
00031009   SET VOLUME = VOLUME(&VOLUME)
00031109   IF &UNIT = THEN DO
00031209      WRITE ***** ERROR: &VOLUME SPECIFIED WITHOUT UNIT
00031309      EXIT CODE(8)
00031409      END
00032009   END
00040009IF &UNIT ^= THEN DO
00041009   SET UNIT = UNIT(&UNIT)
00041109   IF &VOLUME = THEN DO
00041209      WRITE ***** ERROR: &UNIT SPECIFIED WITHOUT VOLUME
00041309      EXIT CODE(8)
00041409      END
00042009   END
00050007FREE DDNAME(SYSIN SYSPRINT SYSUT3 SYSUT4 SYSUT1) ATTRLIST(SYSIN1)
00060007CONTROL MSG
00070007ERROR GOTO CLEANUP2
00080007ATTR SYSIN1 RECFM (F S) LRECL(80) BLKSIZE(80)
00090007ALLOC DDNAME(SYSIN) NEW USING(SYSIN1) BLOCK(80) UNIT(VIO) SPACE(1)
00100007ALLOC DDNAME(SYSPRINT) DSNAME(&PRINT)
00110007ERROR GOTO CLEANUP1
00120007OPENFILE SYSIN OUTPUT
00130007IF &LIST=LIST && &NOLIST=NOLIST THEN DO
00140007  SET LIST=
00150007  SET NOLIST=
00160007  WRITENR LIST AND NOLIST ARE EXCLUSIVE -- ENTER THE CORRECT VALUE:
00170007  READW: READ &WHICH
00180007  SET &LW=&LENGTH(&WHICH)
00190007  IF &LW<=6 THEN +
00200007    IF &SUBSTR(1:&LW,&WHICH)=&SUBSTR(1:&LW,NOLIST) THEN SET NOLIST=NOLIST
00210007  IF &LW<=4 THEN +
00220007    IF &SUBSTR(1:&LW,&WHICH)=&SUBSTR(1:&LW,LIST) THEN SET LIST=LIST
00230007  IF &LIST=&STR() && &NOLIST=&STR() THEN DO
00240007    WRITENR WHAT?
00250007    GOTO READW
00260007    END
00270007  END
00280007IF &LIST=LIST THEN SET &LISTNO=&STR()
00290007ELSE SET &LISTNO=&STR(,LIST=NO)
00300007SET SYSIN=&STR( COPY OUTDD=SYSUT1,INDD=SYSUT1&LISTNO)
00310007PUTFILE SYSIN
00320007CLOSFILE SYSIN
00330007ERROR GOTO CLEANUP2
00340011ALLOC DDNAME(SYSUT3) CYL SPA(1 1) UNIT(VIO)
00350011ALLOC DDNAME(SYSUT4) CYL SPA(1 1) UNIT(VIO)
00360010ALLOC DDNAME(SYSUT1) DA(&DSNAME) &SHR &OLD &VOLUME &UNIT
00370007SET MAXCC=0
00380007CONTROL NOFLUSH
00381007ERROR DO
00382007  ERROR GOTO CLEANUP2
00382107  CONTROL MSG
00382207  CALL 'SYS1.LINKLIB(IEBCOPY)'
00382307  GOTO CLEANUP2
00383007END
00383107CONTROL NOMSG
00384007TSOEXEC TIME
00386007ERROR GOTO CLEANUP2
00387007CONTROL MSG
00390007TSOEXEC CALL 'SYS1.LINKLIB(IEBCOPY)'
00400007GOTO CLEANUP2
00410007CLEANUP1: ERROR GOTO CLEANUP2
00420007CLOSFILE SYSIN
00430007CLEANUP2: ERROR GOTO CLEANUP3
00440007FREE DDNAME(SYSIN SYSPRINT SYSUT3 SYSUT4 SYSUT1) ATTRLIST(SYSIN1)
00450007CLEANUP3: ERROR EXIT CODE(&MAXCC)
00460007ALLOC DDNAME(SYSIN) DSNAME(*)
00470007ALLOC DDNAME(SYSPRINT) DSNAME(*)
00480007EXIT CODE(0)