00010002 PROC 1 DS FIRST LAST ADD REPLACE NOLIST LIST NOPROMPT PROMPT SHR OLD -
00020003        HELP DELETE DDNAME(SYSPROC) DISP(SHR) DEBUG NOERROR
00030002 CONTROL NOFLUSH
00040002 IF &DS = HELP OR &HELP = HELP THEN DO
00050002    HELP REALLOC
00060002    EXIT CODE(0)
00070002    END
00080002 IF &OLD = OLD THEN SET DISP = OLD
00090002 IF &PROMPT = PROMPT THEN DO
00100002    SET LIST = LIST
00110002    ISPEXEC CONTROL DISPLAY LINE
00120002    END
00130004 IF &LIST = LIST THEN CONTROL LIST NOFLUSH
00140002 SET SYSOUTTRAP = 1000
00150002 LISTA ST
00160002 SET SYSOUTTRAP = 0
00170002 SET FOUND = NO
00180002 SET DSFOUND = NO
00190002 SET CONCAT = &STR()
00200002 SET PREF = &SYSPREF..
00210002 SET PREFL = &LENGTH(&STR(&PREF))
00220002 IF &SUBSTR(1:1,&DS) = ' THEN SET DS1 = &DS
00230002 ELSE IF &SYSPREF = THEN SET DS1 = '&DS'
00240002 ELSE SET DS1 = '&SYSPREF..&DS'
00250002 SET I = 1
00260002 DO WHILE &STR(&FOUND) = NO AND &SYSOUTLINE >= &I
00270002    SET DDN = &&SYSOUTLINE&I..
00280002    IF &DEBUG. = DEBUG THEN WRITE DEBUG DDN IS &DDN.
00290002    IF &LENGTH(&STR(&DDN)) > 9 THEN -
00300002       IF &STR(&SUBSTR(2:10,&DDN)) = &STR( &DDNAME) THEN DO
00310002          SET FOUND = YES
00320002          SET I = &I - 1
00330002          SET DSN = &&SYSOUTLINE&I..
00340002          IF &DEBUG. = DEBUG THEN WRITE DEBUG DSN IS &DSN.
00350002          IF &LIST = LIST THEN WRITE &DDNAME ALLOCATION IS
00360002          IF &LIST = LIST THEN WRITE    '&DSN'
00370002          SET DS2 = '&DSN'
00380002          IF &LENGTH(&DSN) > &PREFL THEN -
00390002             IF &SUBSTR(1:&PREFL,&DSN) = &STR(&PREF) THEN DO
00400002                SET DSN = &SUBSTR(&EVAL(&PREFL+1):&LENGTH(&DSN),&DSN)
00410002                IF &DEBUG. = DEBUG THEN WRITE DEBUG DSN IS &DSN.
00420002                END
00430002             ELSE DO
00440002                SET DSN = '&DSN'
00450002                IF &DEBUG. = DEBUG THEN WRITE DEBUG DSN IS &DSN.
00460002                END
00470002          ELSE DO
00480002             SET DSN = '&DSN'
00490002             IF &DEBUG. = DEBUG THEN WRITE DEBUG DSN IS &DSN.
00500002             END
00510002          IF &REPLACE = AND &DS1 ^= &DS2 THEN SET CONCAT = &DSN
00520002          IF &DS1 = &DS2 THEN SET DSFOUND = YES
00530002          END
00540002       ELSE SET I = &I + 1
00550002    ELSE SET I = &I + 1
00560002    END
00570002 IF &FOUND = YES THEN DO
00580002    DO WHILE &EVAL(&I+3) <= &SYSOUTLINE
00590002       SET I = &I + 3
00600002       SET DDN = &&SYSOUTLINE&I
00610002       IF &DEBUG. = DEBUG THEN WRITE DEBUG DDN IS &DDN.
00620002       IF &STR(&SUBSTR(1:3,&DDN)) = &STR() THEN DO
00630002          IF &REPLACE = REPLACE AND &LAST = LAST THEN -
00640002             SET CONCAT = &CONCAT&STR( ')&DSN'
00650002          SET I = &I - 1
00660002          SET DSN = &&SYSOUTLINE&I
00670002          IF &DEBUG. = DEBUG THEN WRITE DEBUG DSN IS &DSN.
00680002          IF &LIST = LIST THEN WRITE    '&DSN'
00690002          SET DS2 = '&DSN'
00700002          IF &LENGTH(&DSN) > &PREFL THEN -
00710002             IF &SUBSTR(1:&PREFL,&DSN) = &STR(&PREF) THEN DO
00720002                SET DSN = &SUBSTR(&EVAL(&PREFL+1):&LENGTH(&DSN),&DSN)
00730002                IF &DEBUG. = DEBUG THEN WRITE DEBUG DSN IS &DSN.
00740002                END
00750002             ELSE DO
00760002                SET DSN = '&DSN'
00770002                IF &DEBUG. = DEBUG THEN WRITE DEBUG DSN IS &DSN
00780002                END
00790002          ELSE DO
00800002             SET DSN = '&DSN'
00810002             IF &DEBUG. = DEBUG THEN WRITE DEBUG DSN IS &DSN
00820002             END
00830002          IF &REPLACE = OR &LAST = THEN -
00840002             IF &DS1 ^= &DS2 THEN SET CONCAT = &CONCAT &DSN
00850002          IF &DS1 = &DS2 THEN SET DSFOUND = YES
00860002          END
00870002       ELSE SET I = &SYSOUTLINE
00880002       END
00890002    END
00900002 ELSE DO
00910002    IF &LIST = LIST THEN WRITE &DDNAME IS NOT ALLOCATED.
00920002    END
00930002 IF &LIST = LIST THEN DO
00940002    IF &DELETE = DELETE THEN DO
00950002       IF &DSFOUND = YES THEN WRITE &DS WILL BE DELETED FROM THE LIST.
00960002       END
00970002    ELSE IF &REPLACE = REPLACE THEN DO
00980002       IF &LAST = LAST THEN WRITE THE LAST DATASET WILL BE REPLACED BY &DS..
00990002       ELSE WRITE THE FIRST DATASET WILL BE REPLACED BY &DS..
01000002       END
01010002    ELSE DO
01020002       IF &LAST = LAST THEN WRITE &DS WILL BE ADDED TO THE END OF THIS LIST.
01030002       ELSE WRITE &DS WILL BE ADDED TO THE TOP OF THIS LIST.
01040002       END
01050002    END
01060002 IF &DELETE = DELETE THEN DO
01070002    IF &DSFOUND = NO THEN DO
01071003       IF &NOERROR ^= NOERROR THEN +
01080003          WRITE DATASET &DS1 WAS NOT FOUND IN &DDNAME ALLOCATION.
01090002       EXIT CODE(4)
01100002       END
01110002    SET CONCAT2 = &CONCAT
01120002    END
01130002 ELSE IF &LAST = LAST THEN SET CONCAT2 = &CONCAT &DS
01140002 ELSE SET CONCAT2 = &DS &CONCAT
01150002 IF &PROMPT = PROMPT THEN DO
01160002    WRITE ALLOCATION WILL BE CHANGED WITH THE FOLLOWING COMMAND:
01170002    IF &CONCAT2 = THEN WRITE    FREE FI(&DDNAME)
01180002    ELSE WRITE    ALLOC FI(&DDNAME) DS(&CONCAT2) &DISP
01190002    WRITENR ENTER YES TO EXECUTE THIS COMMAND ===>
01200002    READ
01210002    IF &SYSDVAL ^= YES THEN EXIT CODE(0)
01220002    END
01230002 IF &CONCAT2 = THEN FREE FI(&DDNAME)
01240002 ELSE ALLOC FI(&DDNAME) DS(&CONCAT2) &DISP REUSE
01250002 SET RC = &LASTCC
01260002 IF &RC ^= 0 THEN DO
01270002    WRITE ALLOCATION FAILED, RETURN CODE &RC..
01280002    IF &PROMPT = PROMPT THEN DO
01290002       WRITE ALLOCATION WILL BE CHANGED WITH THE FOLLOWING COMMAND:
01300002       WRITE    ALLOC FI(&DDNAME) DS(&CONCAT) &DISP
01310002       WRITENR ENTER YES TO EXECUTE THIS COMMAND ===>
01320002       READ
01330002       IF &SYSDVAL ^= YES THEN EXIT CODE(0)
01340002       END
01350002    ALLOC FI(&DDNAME) DS(&CONCAT) &DISP REUSE
01360002    SET RC = &LASTCC
01370002    END
01380002 EXIT CODE(&RC)