IBM Mainframe Forum Index
 
Log In
 
IBM Mainframe Forum Index Mainframe: Search IBM Mainframe Forum: FAQ Register
 

New GDG bases from existing GDG bases


IBM Mainframe Forums -> CLIST & REXX
Post new topic   Reply to topic
View previous topic :: View next topic  
Author Message
expat

Global Moderator


Joined: 14 Mar 2007
Posts: 8797
Location: Welsh Wales

PostPosted: Sat May 26, 2007 1:15 am
Reply with quote

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.

Hope this is useful to some other users.

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"
Back to top
View user's profile Send private message
View previous topic :: :: View next topic  
Post new topic   Reply to topic View Bookmarks
All times are GMT + 6 Hours
Forum Index -> CLIST & REXX

 


Similar Topics
Topic Forum Replies
No new posts Adding first / last acct numerber to ... DFSORT/ICETOOL 7
No new posts I want to append a record in an exist... CLIST & REXX 17
No new posts Read file names from existing file th... DFSORT/ICETOOL 6
No new posts Add column to existing records using ... JCL & VSAM 2
No new posts A command to change LRECL of an exist... JCL & VSAM 7
Search our Forums:

Back to Top