Back To LeighWeb Mainframe Utilities Page

/**********************************************************************
/* UTILITY: CICSDSN                                                   *
/* AUTHOR: DAVID LEIGH                                                *
/* FUNCTION: RETURN THE DATASET NAME ASSOCIATED WITH A CICS FILE NAME *
/*           OR ALL THE DATASETS ASSOCIATED WITH A PARTIAL CICS FILE  *
/*           NAME.                                                    *
/**********************************************************************
PROC 1 CICS_FILE_NAME_TO_SCAN_FOR /* CICS FILE NAME OR PARTIAL NAME */ +
       LIBRARY(SYS4.CICS.V330.TABLES)   /* LIBRARY CONTAINING FCT'S */ +
       AUDIT    /* INDICATE THAT WE WANT TO AUDIT THE ACTUAL OUTPUT */ +
       BATCH         /* INDICATE THAT WE ARE IN A BATCH ENVIRONMENT */
/*** 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

SET FILE = &STR(&CICS_FILE_NAME_TO_SCAN_FOR)
IF &STR(&FILE) = HELP THEN GOTO HELPSEC
IF &STR(&FILE) = &STR(*ALL) THEN SET FILE =
ISPEXEC VPUT FILE SHARED

/**********************************************************************
/* TELL THE USER YOU'RE PREPARING TO SCAN                             *
/**********************************************************************
IF &BATCH ¬= BATCH THEN +
    DO
        SET ZEDLMSG = &STR(*** PREPARING TO SCAN THE FCT ALC MACROS ***)
        ISPEXEC CONTROL DISPLAY LOCK
        ISPEXEC DISPLAY MSG(UTLZ000W)
    END

/**********************************************************************
/* PREPARE FOR THE SCAN                                               *
/**********************************************************************
FREE DD(NEWDD OUTDD SYSIN)
ALLOC DD(NEWDD) DSN('&LIBRARY') SHR
DELETE '&SYSUID..TEMP.CICSDSN.OUTDD'
ALLOC DD(OUTDD) DSN('&SYSUID..TEMP.CICSDSN.OUTDD') +
                NEW CATALOG +
                UNIT(SYSDA) VOLUME(WRK$$$) +
                SPACE(1,1) CYLINDERS RELEASE +
                RECFM(F B) LRECL(132) BLKSIZE(23364) DSORG(PS)
DELETE '&SYSUID..TEMP.CICSDSN.SYSIN'
ALLOC DD(SYSIN) DSN('&SYSUID..TEMP.CICSDSN.SYSIN') +
                NEW CATALOG +
                UNIT(SYSDA) VOLUME(WRK$$$) +
                SPACE(1,1) TRACKS RELEASE +
                RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS)
OPENFILE SYSIN OUTPUT
SET SYSIN = &STR(SLIST OFF)
PUTFILE SYSIN

SET SYSOUTTRAP = 1000
PDS '&LIBRARY' FIND *FCT0 '         TITLE '
SET LINES = &SYSOUTLINE
SET SYSOUTTRAP = 0

DO &I = 1 TO &LINES
    SET SYSDVAL = &STR(&SYSNSUB(2,&&SYSOUTLINE&I))
    IF &SYSINDEX(&STR(** FIND ),&STR(&SYSDVAL)) > 0 THEN +
        DO
            SET MEMS = &MEMS + 1
            READDVAL NULL1 NULL2 MEMBER
            SET MEMBER&MEMS = &STR(&MEMBER)
            SET SYSIN = &STR(SELECT &SYSNSUB(2,&&MEMBER&MEMS))
            PUTFILE SYSIN
            SET I = &I + 1
            SET SYSDVAL = &STR(&SYSNSUB(2,&&SYSOUTLINE&I))
            READDVAL NULL1 NULL2 REGION
            SET REGION&MEMS = &STR(®ION)
            ISPEXEC VPUT (REGION&MEMS MEMBER&MEMS)
        END
END
ISPEXEC VPUT MEMS SHARED

SET SYSIN = &STR(CMPCOLM 1:31)
PUTFILE SYSIN
SET SYSIN = &STR(LSTCOLM 16:71)
PUTFILE SYSIN
SET SYSIN = &STR(SRCHFOR '         DATASET=')
PUTFILE SYSIN
SET SYSIN = &STR(SRCHFOR '         DSNAME=')
PUTFILE SYSIN
CLOSFILE SYSIN

/**********************************************************************
/* TELL THE USER YOU'RE SCANNING                                      *
/**********************************************************************
IF &BATCH ¬= BATCH THEN +
    DO
        SET ZEDLMSG = &STR(*** SCANNING THE FCT ALC MACROS ***)
        ISPEXEC CONTROL DISPLAY LOCK
        ISPEXEC DISPLAY MSG(UTLZ000W)
    END

/**********************************************************************
/* SCAN AWAY!                                                         *
/**********************************************************************
ISPEXEC SELECT PGM(ISRSUPC) PARM(SRCHCMP IDPFX NOPRTCC)

ISPEXEC LMINIT DATAID(DID) DDNAME(OUTDD)
ISPEXEC EDIT DATAID(&DID) MACRO(CICSDSNM)

FREE DD(NEWDD OUTDD SYSIN)

EXIT
HELPSEC: +
ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL)
SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR CICSDSN UTILITY +
                   *** NO PROCESSING PERFORMED ***)
ISPEXEC SETMSG MSG(UTLZ000)
EXIT