Back To LeighWeb Mainframe Utilities Page

/**********************************************************************
/* UTILITY: UNARC                                                     *
/* AUTHOR: DAVID LEIGH                                                *
/* FUNCTION: CREATE A BATCH JOB FOR UNARCHIVING (OR DELETING)         *
/*           CURRENTLY ARCHIVED DATASETS.                             *
/**********************************************************************
PROC 0 HELP

/*** CHECK THE DEBUG SWITCH ***/
ISPEXEC VGET DBGSWTCH PROFILE
IF &DBGSWTCH = ON THEN +
    CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS
ELSE +
    CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS

/**********************************************************************
/* TELL THE USER WHAT'S HAPPENING                                     *
/**********************************************************************
SET ZEDLMSG = &STR(*** FINDING ARCHIVE DATASETS ***)
ISPEXEC CONTROL DISPLAY LOCK
ISPEXEC DISPLAY MSG(UTLZ000W)

/**********************************************************************
/* GET THE ARCHIVE DATASET NAMES                                      *
/**********************************************************************
CONTROL MSG
SET SYSOUTTRAP = 10000
LISTCAT VOLUME
SET SYSOUTTRAP = 0
SET A = &SYSOUTLINE
CONTROL NOMSG

/**********************************************************************
/* LOAD A TABLE OF THE ARCHIVE DATASETS                               *
/**********************************************************************
ISPEXEC TBCREATE TEMPTABL NOWRITE REPLACE KEYS() NAMES(DATASET)

DO &B = 1 TO &A
    SET SYSDVAL = &&SYSOUTLINE&B
    READDVAL LINE
    SELECT
        WHEN (&SYSINDEX(&STR(&SYSUID),&STR(&LINE))=1) DO
            IF &NUMV > 0 THEN +
                DO
                    DO &C = 1 TO &NUMD
                        SET DATASET = &&DSN&C
                        SET DATASET = &DATASET
                        SET VOLUME =
                        DO &D = 1 TO &NUMV
                            SET XVOL = &&VOL&D
                            SET VOLUME = &STR(&VOLUME &XVOL)
                        END
                        IF &SYSINDEX(&STR(ARCIVE),&STR(&VOLUME)) > 0 +
                            THEN ISPEXEC TBADD TEMPTABL
                    END
                    SET NUMV = 0
                    SET NUMD = 0
                END
            SET NUMD = &NUMD + 1
            SET DSN&NUMD = &LINE
        END
        WHEN (&STR(&LINE) = &STR(  --VOLUMES--))
        WHEN (&STR(&LINE) = &STR(LISTCAT VOLUME))
        OTHERWISE DO
            SET NUMV = &NUMV + 1
            SET VOL&NUMV = &LINE
        END
    END
END

/**********************************************************************
/* TELL THE USER WHAT'S HAPPENING                                     *
/**********************************************************************
SET ZEDLMSG = &STR(*** CREATING THE UNARCHIVE JCL ***)
ISPEXEC CONTROL DISPLAY LOCK
ISPEXEC DISPLAY MSG(UTLZ000W)

/**********************************************************************
/* CREATE THE UNARCHIVE JCL                                           *
/**********************************************************************
SET TEMPJCL = &STR(&SYSUID..TEMP.UNARC.JCL)
DELETE '&TEMPJCL'
FREE DDNAME(ISPFILE)
ALLOCATE DDNAME(ISPFILE) DSN('&TEMPJCL') +
         NEW CATALOG +
         UNIT(SYSDA) VOLUME(WRK$$$) +
         SPACE(1,1) TRACKS RELEASE +
         RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS)

ISPEXEC FTOPEN
ISPEXEC FTINCL UNARC
SET SAVECC = &LASTCC
ISPEXEC FTCLOSE
FREE DDNAME(ISPFILE)

IF &SAVECC > 0 THEN +
    DO
        ISPEXEC VGET ZERRLM
        SET ZEDSMSG = &STR(JCL CREATION ERROR)
        SET ZEDLMSG = &STR(&ZERRLM)
        ISPEXEC SETMSG MSG(UTLZ001)
    END
ELSE +
    DO
        SET ZEDLMSG = &STR(*** NOTE:  YOU MUST SUBMIT THIS +
                           JCL YOURSELF ***)
        ISPEXEC SETMSG MSG(UTLZ000W)
        ISPEXEC EDIT DATASET('&TEMPJCL')
    END

ISPEXEC TBEND TEMPTABL

EXIT

/**********************************************************************
/* DISPLAY ANY "HELP" WHICH IS AVAILABLE FOR THIS UTILITY             *
/**********************************************************************
HELPSEC: +
ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL)
SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR UNARC UTILITY +
                   *** NO PROCESSING PERFORMED ***)
ISPEXEC SETMSG MSG(UTLZ000)
EXIT