expat
Intermediate
Joined: 01 Mar 2007
Posts: 475
Topics: 9
Location: Welsh Wales
|
 Posted: Fri May 25, 2007 2:39 pm Post subject: Define new GDG bases from existing ones with name changes |
 |
|
I posted this on another forum today in response to a request - to define a new set of GDG bases from existing GDG definitions but changing the names.
The JCL is set up so that I can make minimal changes to anything when I change sites.
PREFIX = if you need a group prefix before your uid
SYSTID = system id, if required.
IDCAMS.GDGREFS is part of the dsname that holds the GDG defs. -
&PREFIX.&SYSUID..&SYSTID.IDCAMS.GDGREFS .... if you don't code anything it goes to
&PREFIX.&SYSUID..&SYSTID.GDGREFS
The change DD *
change-from change-to
This need not be the HLQ, 2LQ etc. etc. but any character string within the base name.
More than one change can be entered on a new line.
| Code: |
//*
// SET PREFIX='L.',
// SYSTID=''
//*
// JCLLIB ORDER=(&PREFIX.&SYSUID..&SYSTID.TEMPISPF)
//*
//BATCH EXEC ISPFBAT,
// PARM='ISPSTART CMD(%CSIGDGS &PREFIX.. &SYSTID.. IDCAMS.GDGDEFS)'
//CATIN DD *
LF.X48201.**
/*
//CHANGE DD *
LF PFX
/*
//
|
REXX CODE
| Code: |
/* REXX ** INVOKE CSI VIA BATCH REXX PROCESS */
/* GDG DEFINITIONS FROM CATALOG ENTRIES ONLY */
CRD = COPIES(' ',70)!!"-"
SIGNAL ON SYNTAX NAME ERR
ARG PFX SYS DSN .
SYSUID = STRIP(SYSVAR(SYSUID)!!".")
IF PFX = "." THEN PFX = ""
ELSE PFX = SUBSTR(PFX,1,LENGTH(PFX)-1)
IF SYS = "." THEN SYS = ""
ELSE SYS = SUBSTR(SYS,1,LENGTH(SYS)-1)
IF DSN = "" THEN DSN = "GDGDEFS"
ELSE DSN = STRIP(DSN)
CARDOUT = STRIP(PFX!!SYSUID!!SYS!!DSN)
"FREE FI(CARDOUT)"
"DEL '"CARDOUT"'"
"ALLOC FI(CARDOUT) DA('"CARDOUT"') NEW TRACKS SPACE(75 75) RELEASE
RECFM(F B) LRECL(80)"
/********************************************************************/
/* NAME: IGGCSIRX */
/********************************************************************/
CNTNSR = 0
CNTEMP = 0
"EXECIO * DISKR CATIN ( STEM CAT. FINIS" /* READ KEY SELECTIONS */
DO KCNT = 1 TO CAT.0 /* PROCESS SELECTIONS */
KEY = SUBSTR(CAT.KCNT,1,44) /* GET KEY */
/********************************************************************/
/* INITIALIZE THE PARM LIST */
/********************************************************************/
MODRSNRC = SUBSTR(' ',1,4) /* CLEAR MODULE/RETURN/REASON */
CSIFILTK = SUBSTR(KEY,1,44) /* MOVE FILTER KEY INTO LIST */
CSICATNM = SUBSTR(' ',1,44) /* CLEAR CATALOG NAME */
CSIRESNM = SUBSTR(' ',1,44) /* CLEAR RESUME NAME */
CSIDTYPS = 'B ' /* GDG BASE ENTRIES ONLY */
CSICLDI = SUBSTR('Y',1,1) /* INDICATE DATA AND INDEX */
CSIRESUM = SUBSTR(' ',1,1) /* CLEAR RESUME FLAG */
CSIS1CAT = SUBSTR(' ',1,1) /* INDICATE SEARCH > 1 CATALOGS*/
CSIRESRV = SUBSTR(' ',1,1) /* CLEAR RESERVE CHARACTER */
CSINUMEN = '0003'X /* INIT NUMBER OF FIELDS */
CSIFLD1 = 'VOLSER ' /* FIELD 1 - VOLSER(S) */
CSIFLD2 = 'GDGLIMIT' /* FIELD 2 - GDG LIMIT */
CSIFLD3 = 'GDGATTR ' /* FIELD 3 - GDG ATTRIBUTES */
/********************************************************************/
/* BUILD THE SELECTION CRITERIA FIELDS PART OF PARAMETER LIST */
/********************************************************************/
CSIOPTS = CSICLDI !! CSIRESUM !! CSIS1CAT !! CSIRESRV
CSIFIELD = CSIFILTK !! CSICATNM !! CSIRESNM !! CSIDTYPS !! CSIOPTS
CSIFIELD = CSIFIELD !! CSINUMEN !! CSIFLD1 !! CSIFLD2 !! CSIFLD3
/********************************************************************/
/* INITIALIZE AND BUILD WORK ARE OUTPUT PART OF PARAMETER LIST */
/********************************************************************/
WORKLEN = 65536 /* 64K WORK AREA */
DWORK = '00010000'X !! COPIES('00'X,WORKLEN-4)
/********************************************************************/
/* INITIALIZE WORK VARIABLES */
/********************************************************************/
RESUME = 'Y'
CATNAMET = SUBSTR(' ',1,44)
DNAMET = SUBSTR(' ',1,44)
/********************************************************************/
/* SET UP LOOP FOR RESUME (IF A RESUME IS NCESSARY) */
/********************************************************************/
DO WHILE RESUME = 'Y'
/********************************************************************/
/* ISSUE LINK TO CATALOG GENERIC FILTER INTERFACE */
/********************************************************************/
ADDRESS LINKPGM 'IGGCSI00 MODRSNRC CSIFIELD DWORK'
RESUME = SUBSTR(CSIFIELD,150,1) /* GET RESUME FLAG FOR NEXT LOOP */
USEDLEN = C2D(SUBSTR(DWORK,9,4)) /* GET AMOUNT OF WORK AREA USED */
POS1=15 /* STARTING POSITION */
/********************************************************************/
/* PROCESS DATA RETURNED IN WORK AREA */
/********************************************************************/
DO WHILE POS1 < USEDLEN /* DO UNTIL ALL DATA IS PROCESSED*/
IF SUBSTR(DWORK,POS1+1,1) = '0' /* IF CATALOG, PRINT CATALOG HEAD*/
THEN DO
CATNAME=SUBSTR(DWORK,POS1+2,44)
IF CATNAME ^= CATNAMET THEN /* IF RESUME NAME MAY ALREADY BE*/
DO /* PRINTED */
/* SAY 'CATALOG ' CATNAME IF NOT, PRINT IT */
/* SAY ' ' */
/* CATNAMET = CATNAME */
END
POS1 = POS1 + 50
END
DNAME = SUBSTR(DWORK,POS1+2,44) /* GET ENTRY NAME */
/********************************************************************/
/* ASSIGN ENTRY TYPE NAME */
/********************************************************************/
IF SUBSTR(DWORK,POS1+1,1) = 'C' THEN DTYPE = 'CLUSTER '
ELSE
IF SUBSTR(DWORK,POS1+1,1) = 'D' THEN DTYPE = 'DATA '
ELSE
IF SUBSTR(DWORK,POS1+1,1) = 'I' THEN DTYPE = 'INDEX '
ELSE
IF SUBSTR(DWORK,POS1+1,1) = 'A' THEN DTYPE = 'NONVSAM '
ELSE
IF SUBSTR(DWORK,POS1+1,1) = 'H' THEN DTYPE = 'GDS '
ELSE
IF SUBSTR(DWORK,POS1+1,1) = 'B' THEN DTYPE = 'GDG '
ELSE
IF SUBSTR(DWORK,POS1+1,1) = 'R' THEN DTYPE = 'PATH '
ELSE
IF SUBSTR(DWORK,POS1+1,1) = 'G' THEN DTYPE = 'AIX '
ELSE
IF SUBSTR(DWORK,POS1+1,1) = 'X' THEN DTYPE = 'ALIAS '
ELSE
IF SUBSTR(DWORK,POS1+1,1) = 'U' THEN DTYPE = 'UCAT '
ELSE
DTYPE = ' '
/********************************************************************/
/* HAVE NAME AND TYPE, GET VOLSER INFO */
/********************************************************************/
POS1 = POS1 + 46
NUMVOL = C2D(SUBSTR(DWORK,POS1+4,2))/6 /* HOW MANY VOLSERS ? */
/* */
POS2 = POS1+10 /* POSITION ON DATA */
DO I = 1 TO NUMVOL /* MOVE VOLSERS TO OUTPUT FIELDS */
POS2 = POS2 + 6
END
POS2 = POS1 + C2D(SUBSTR(DWORK,POS1,2)) - 2
GDGLIM = C2D(SUBSTR(DWORK,POS2,1))
POS2 = POS2 + 1
GDGA = X2B(C2X(SUBSTR(DWORK,POS2,1)))
GDGA1 = SUBSTR(GDGA,1,1)
GDGA2 = SUBSTR(GDGA,2,1)
GDAT1 = 'NOEMPTY'
IF GDGA1 = '1' THEN DO
GDAT1 = 'EMPTY'
END
GDAT2 = 'SCRATCH'
IF GDGA2 = '0' THEN DO
GDAT2 = 'NOSCR'
END
IF DNAMET ^= DNAME THEN DO /* IF RESUME, NAME MAY ALREADY */
/* PRINTED */
/* IF NOT, PRINT IT */
IF DTYPE = 'GDG ' THEN DO
QUEUE OVERLAY("DEFINE GDG",CRD,2)
QUEUE OVERLAY("(NAME("STRIP(DNAME)")",CRD,10)
QUEUE OVERLAY("LIMIT("STRIP(GDGLIM)")",CRD,10)
QUEUE OVERLAY(GDAT1 GDAT2 ")"COPIES(' ',70),CRD,10)
"EXECIO " QUEUED() "DISKW CARDOUT"
END
DNAMET=DNAME
END
/********************************************************************/
/* GET POSITION OF NEXT ENTRY */
/********************************************************************/
POS1 = POS1 + C2D(SUBSTR(DWORK,POS1,2))
END
END
END
"EXECIO 0 DISKW CARDOUT ( FINIS"
/********************************************************************/
/* ISPF EDIT COMMANDS FOR ANY CHANGES THAT ARE REQUIRED */
/********************************************************************/
"EXECIO * DISKR CHANGE ( STEM CHG. FINIS"
IF CHG.0 > 0 THEN DO
DO A = 1 TO CHG.0
PARSE VAR CHG.A PFXO PFXN .
PFXO = STRIP(PFXO)
PFXN = STRIP(PFXN)
"ISPEXEC VPUT (PFXO PFXN) SHARED"
"ISPEXEC EDIT DATASET('"CARDOUT"') MACRO(CSIVSAMM)"
END
END
EXIT
/* STANDARD ERROR ROUTINE - CHANGE SAY VARIABLES AS REQUIRED. */
ERR:
SIGNAL OFF SYNTAX
SAY RIGHT(SIGL,4) ">>>" SOURCELINE(SIGL)
SAY " "
SAY "ERROR ROUTINE HAS BEEN ENTERED"
SAY " "
SAY "CRD " CRD
SAY "NAME " DNAME
SAY "TYPE " DTYPE
SAY "GDGLIM " GDGLIM
SAY "GDAT1 " GDAT1
SAY "GDAT2 " GDAT2
SAY " "
TRACE I
INTERPRET SOURCELINE(SIGL)
SAY RIGHT(RC,4) ">>>" ERRORTEXT(RC)
|
THE MACRO
| Code: |
/* REXX *** EDIT VSAM CARDS AS PER CHANGE CARDS - REXX=CSIVSAM */
ADDRESS TSO
"ISPEXEC VGET (PFXO PFXN) SHARED"
"ISREDIT MACRO"
"ISREDIT C '"PFXO"' '"PFXN"' ALL"
"ISREDIT END"
|
|
|
FAQ
Search
Quick Manuals
Register
Profile
Log in to check your private messages
Log in
