REXX Tool - GDG Handling Tool
REXX Tool - GDG Handling Tool
REXX Tool - GDG Handling Tool
1. Introduction
GDG stands for Generation Data Group and is a method used on the mainframe
to allow a group of related files to be created that can be referenced individually or as
a group. The GDG Handler is a tool that performs various operations on GDG. The
operations supported by this handler are:
• Defining a GDG
• Deleting a GDG base
• Deleting the GDG entries
• Altering a GDG
• Displaying a GDG
2. Process
The GDG Handler gets from the user whether he wants to perform any of the
options mentioned above with the help of a panel. The various options are explained in
detail as below:
3. Components
The components for GDG Property Finder Tool listed below can be found in IBM
Mainframe:
/* REXX */
/* Program-id GDGS */
/* Remarks This REXX allows the user to do */
/* the following IDCAMS GDG functions: */
/* */
/* 1. Define a GDG */
/* 2. Delete a GDG base entry */
/* 3. Delete all GDG entries */
/* 4. Alter a GDG */
/* 5. Display a GDG */
/*trace i */
Address Ispexec "control errors return"
Address Tso
alloc_flag= 0 /* allocation flag */
lmf_flag= 0 /* LMF allocation flag */
reclen= 80 /* Record Length */
gdef= 1 /* GDG member No */
ADDRESS ISPEXEC
"LIBDEF ISPPLIB DATASET ID('MGT1T.XXX.PANEL.SOURCE.C00005')"
do forever /* main loop */
call display_the_main_panel /* display main panel */
gdgbname= ' ' /* reset */
select
when defgdg = '/' then do /* define GDG? */
call define_gdg /* yes- */
end
when delgdg = '/' then do /* delete GDG? */
call delete_gdg /* yes- */
end
when delgdge = '/' then do /* delete GDG? */
call delete_gdg_entries /* yes- */
end
when altgdg = '/' then do /* alter GDG? */
call alter_gdg /* yes- */
end
when disgdg = '/' then do /* display GDG? */
call display_gdg /* yes- */
end
otherwise
call display_error_panel_one /* error panel */
end
ADDRESS "ISPEXEC" "REMPOP" /* remove pop-up */
End
define_gdg:
defowner= userid() /* set owner to user-id */
call display_define_gdg_panel /* display define GDG pan */
if (rc = 8) then do /* return? */
ADDRESS "ISPEXEC" "REMPOP" /* remove pop-up */
return /* return */
end
ADDRESS "ISPEXEC" "REMPOP" /* remove pop-up */
call display_progress_panel /* display progress panel */
select
when (subbat = '/') then do /* batch submit? */
call define_gdg_under_batch /* yes */
end
when (savepds = '/') then do /* save as PDS member */
call alloc_pds /* allocate PDS */
call initialise_pds /* Init PDS */
call define_gdg_into_pds /* define PDS member */
end
otherwise
call define_gdg_under_tso /* issue command under TSO*/
end
ADDRESS "ISPEXEC" "REMPOP" /* remove pop-up */
return
delete_gdg:
do forever
call obtain_gdg_base_for_delete /* obtain GDG base name */
if (rc = 8) then do /* return? */
ADDRESS "ISPEXEC" "REMPOP" /* remove pop-up */
return /* yes- */
end
call obtain_gdg_information /* check for just base */
if (rc ª= 0) then do /* return? */
iterate /* yes- */
end
if (x ª= 0) then do /* associations present? */
gdgasc= x /* no of assocations */
call associations_present_display /* inform user */
iterate /* lets go again */
end
call display_invocation_panel /* invocation type */
ADDRESS "ISPEXEC" "REMPOP" /* remove pop-up */
if (rc = 8) then do /* return? */
iterate /* yes- */
end
call display_progress_panel /* display progress panel */
select
when (subbat = '/') then do /* batch submit? */
call delete_gdg_under_batch /* yes */
ADDRESS "ISPEXEC" "REMPOP" /* remove pop-up */
return /* return to caller */
end
when (savepds = '/') then do /* save as PDS member */
call alloc_pds /* allocate PDS */
call initialise_pds /* Init PDS */
call delete_gdg_into_pds /* alter PDS member */
ADDRESS "ISPEXEC" "REMPOP" /* remove pop-up */
return /* return to caller */
end
otherwise
call delete_gdg_under_tso /* issue command under TSO*/
ADDRESS "ISPEXEC" "REMPOP" /* remove pop-up */
return /* return to caller */
end
end
return
delete_gdg_entries:
do forever
call obtain_gdg_base_for_delete /* obtain GDG base name */
if (rc = 8) then do /* return? */
ADDRESS "ISPEXEC" "REMPOP" /* remove pop-up */
return /* yes- */
end
call obtain_gdg_information /* check for just base */
if (rc ª= 0) then do /* return? */
iterate /* yes- */
end
if (x = 0) then do /* associations present? */
gdgasc= x /* no of assocations */
call associations_notpres_display /* inform user */
iterate /* lets go again */
end
call display_invocation_panel /* invocation type */
ADDRESS "ISPEXEC" "REMPOP" /* remove pop-up */
if (rc = 8) then do /* return? */
iterate /* yes- */
end
call display_progress_panel /* display progress panel */
select
when (subbat = '/') then do /* batch submit? */
call delete_gdgents_under_bat /* yes */
ADDRESS "ISPEXEC" "REMPOP" /* remove pop-up */
return /* return to caller */
end
when (savepds = '/') then do /* save as PDS member */
call alloc_pds /* allocate PDS */
call initialise_pds /* Init PDS */
call delete_gdgents_into_pds /* alter PDS member */
ADDRESS "ISPEXEC" "REMPOP" /* remove pop-up */
return /* return to caller */
end
otherwise
call delete_gdgents_under_tso /* issue command under TSO*/
ADDRESS "ISPEXEC" "REMPOP" /* remove pop-up */
return /* return to caller */
end
end
return
alter_gdg:
do forever
call obtain_gdg_base_name /* obtain GDG base name */
if (rc = 8) then do /* return? */
ADDRESS "ISPEXEC" "REMPOP" /* remove pop-up */
return /* yes- */
end
call obtain_gdg_attributes /* obtain current GDG attr*/
if (rc ª= 0) then do /* return? */
iterate /* yes- */
end
call change_gdg_attributes /* change current GDG attr*/
if (rc = 8) then do /* return? */
ADDRESS "ISPEXEC" "REMPOP" /* remove pop-up */
iterate /* yes- */
end
call display_progress_panel /* display progress panel */
select
when (subbat = '/') then do /* batch submit? */
call alter_gdg_under_batch /* yes */
ADDRESS "ISPEXEC" "REMPOP" /* remove pop-up */
return /* return to caller */
end
when (savepds = '/') then do /* save as PDS member */
call alloc_pds /* allocate PDS */
call initialise_pds /* Init PDS */
call alter_gdg_into_pds /* alter PDS member */
ADDRESS "ISPEXEC" "REMPOP" /* remove pop-up */
return /* return to caller */
end
otherwise
call alter_gdg_under_tso /* issue command under TSO*/
ADDRESS "ISPEXEC" "REMPOP" /* remove pop-up */
return /* return to caller */
end
end
return
display_gdg:
do forever
call obtain_gdg_base_name /* obtain GDG base name */
if (rc = 8) then do /* return? */
ADDRESS "ISPEXEC" "REMPOP" /* remove pop-up */
return /* yes- */
end
call obtain_gdg_information /* obtain current GDG info*/
if (rc ª= 0) then do /* return? */
iterate /* yes- */
end
call display_progress_panel /* display progress panel */
ADDRESS "ISPEXEC" "REMPOP" /* remove pop-up */
call build_gdgdsn_table /* build DSN table */
call display_gdg_information /* display GDG information*/
if (dsn.0 ª= 0) then /* close the table */
call table_close /* yes- */
return /* return to caller */
end
return
display_the_main_panel:
ADDRESS "ISPEXEC" "ADDPOP ROW(1) COLUMN(1)" /* pop up position */
ADDRESS "ISPEXEC" "DISPLAY PANEL(GDGPAN01)" /* display menu panel */
if rc = 8 then do /* exit? */
ADDRESS "ISPEXEC" "REMPOP" /* remove pop-up */
call dealloc /* dealloc PDS */
ADDRESS "ISPEXEC" "LIBDEF ISPPLIB" /* remove allocation */
exit 0 /* and quit */
end
if rc > 8 then do /* error? */
say 'Display error rc = 'rc'' /* yes- output message */
call dealloc /* dealloc PDS */
ADDRESS "ISPEXEC" "LIBDEF ISPPLIB" /* remove allocation */
exit 0 /* and quit */
end
return
display_error_panel_one:
gerr1= '----------------------------' /* error message */
gerr2= ' Please Select An Option ' /* error message */
gerr3= '----------------------------' /* error message */
ADDRESS "ISPEXEC" "ADDPOP ROW(2) COLUMN(1)" /* pop up position */
ADDRESS "ISPEXEC" "DISPLAY PANEL(GDGPAN02)" /* display error panel */
if rc > 8 then do /* error? */
say 'Display error rc = 'rc'' /* yes- output message */
call dealloc /* dealloc PDS */
ADDRESS "ISPEXEC" "LIBDEF ISPPLIB" /* remove allocation */
exit(0) /* and quit */
end
ADDRESS "ISPEXEC" "REMPOP" /* remove pop-up */
return
display_define_gdg_panel:
ADDRESS "ISPEXEC" "ADDPOP ROW(2) COLUMN(1)" /* pop up position */
ADDRESS "ISPEXEC" "DISPLAY PANEL(GDGPAN03)" /* display menu panel */
if (rc = 8) then do /* return? */
return /* and quit */
end
if (rc > 8) then do /* error? */
say 'Display error rc = 'rc'' /* yes- output message */
call dealloc /* dealloc PDS */
ADDRESS "ISPEXEC" "LIBDEF ISPPLIB" /* remove allocation */
exit(0) /* and quit */
end
ADDRESS "ISPEXEC" "REMPOP" /* remove pop-up */
call display_invocation_panel /* invocation type */
return
display_invocation_panel:
do forever
shead1= 'Save Operation to a PDS' /* Panel heading */
shead2= 'Invoke Operation Under TSO' /* Panel heading */
ADDRESS "ISPEXEC" "ADDPOP ROW(2) COLUMN(1)" /* pop up position */
ADDRESS "ISPEXEC" "DISPLAY PANEL(GDGPAN04)" /* display INV Panel*/
if (rc = 8) then do /* return? */
return /* yes- */
end
if (rc > 8) then do /* error? */
say 'Display error rc = 'rc'' /* yes- output message */
call dealloc /* dealloc PDS */
ADDRESS "ISPEXEC" "LIBDEF ISPPLIB" /* remove allocation */
exit(0) /* and quit */
end
select
when (subbat = '/') then do /* batch submit? */
return /* yes- */
end
when (savepds = '/') then do /* save as PDS member */
return /* yes- */
end
when (invtso = '/') then do /* invoke under TSO? */
return /* yes- */
end
otherwise
call display_error_panel_one /* error panel */
ADDRESS "ISPEXEC" "REMPOP" /* remove pop-up */
end
end
return
display_gdg_information:
if substr(gdgbname,1,1) = '''' then do /* quoted DSN */
gdgbname= translate(gdgbname,' ','''') /* yes- remove them */
gdgbname= strip(gdgbname,b,' ') /* strip the spaces */
end
else
/* gdgbname= sysvar(sysuid)³³'.'³³gdgbname*//* move in HLQ */
ADDRESS "ISPEXEC" "ADDPOP ROW(2) COLUMN(1)" /* pop up position */
if (dsn.0 = 0) then do
gdgdsn= ' ' /* set to blanks */
volume= ' ' /* set to blanks */
ADDRESS "ISPEXEC" "DISPLAY PANEL(GDGPAN09)"
if (rc > 8) then do /* error? */
say 'Display error rc = 'rc'' /* yes- output message */
call dealloc /* dealloc PDS */
ADDRESS "ISPEXEC" "LIBDEF ISPPLIB" /* remove allocation */
exit(0) /* and quit */
end
else
nop
end
else do
ADDRESS "ISPEXEC" "TBDISPL GDSNTAB PANEL(GDGPAN09)"
if (rc > 8) then do /* error? */
say 'tbdispl error rc = 'rc'' /* yes- output message */
call dealloc /* dealloc PDS */
ADDRESS "ISPEXEC" "LIBDEF ISPPLIB" /* remove allocation */
exit(0) /* and quit */
end
else
nop
end
ADDRESS "ISPEXEC" "REMPOP" /* remove pop-up */
Return
change_gdg_attributes:
if substr(gdgbname,1,1) = '''' then do /* quoted DSN? */
gdgbase= translate(gdgbname,' ','''') /* translate ''' to ' ' */
gdgbase= strip(gdgbase,b,' ') /* strip blanks */
end
ADDRESS "ISPEXEC" "ADDPOP ROW(1) COLUMN(1)" /* pop up position */
ADDRESS "ISPEXEC" "DISPLAY PANEL(GDGPAN08)" /* display panel */
if (rc = 8) then do /* return? */
return /* yes- */
end
if (rc > 8) then do /* error? */
say 'Display error rc = 'rc'' /* yes- output message */
call dealloc /* dealloc PDS */
ADDRESS "ISPEXEC" "LIBDEF ISPPLIB" /* remove allocation */
exit(0) /* and quit */
end
ADDRESS "ISPEXEC" "REMPOP" /* remove pop-up */
call display_invocation_panel /* invocation type */
if (rc = 8) then do /* return? */
return /* yes- */
end
ADDRESS "ISPEXEC" "REMPOP" /* remove pop-up */
Return
display_progress_panel:
ADDRESS "ISPEXEC" "CONTROL DISPLAY LOCK" /* LOCK THE TERMINAL */
if (rc > 8) then do /* error? */
say 'Lock error rc = 'rc'' /* yes- output message */
call dealloc /* dealloc PDS */
ADDRESS "ISPEXEC" "LIBDEF ISPPLIB" /* remove allocation */
exit(0) /* and quit */
end
ADDRESS "ISPEXEC" "ADDPOP ROW(2) COLUMN(1)" /* pop up position */
ADDRESS "ISPEXEC" "DISPLAY PANEL(GDGPAN05)" /* display panel */
if (rc > 8) then do /* error? */
say 'Display error rc = 'rc'' /* yes- output message */
call dealloc /* dealloc PDS */
ADDRESS "ISPEXEC" "LIBDEF ISPPLIB" /* remove allocation */
exit(0) /* and quit */
end
return
associations_present_display:
if substr(gdgbname,1,1) = '''' then do /* quoted DSN */
gdgbname= translate(gdgbname,' ','''') /* yes- remove them */
gdgbname= strip(gdgbname,b,' ') /* strip the spaces */
end
else
/*gdgbname= sysvar(sysuid)³³'.'³³gdgbname */ /* move in HLQ */
ADDRESS "ISPEXEC" "ADDPOP ROW(2) COLUMN(1)" /* pop up position */
ADDRESS "ISPEXEC" "DISPLAY PANEL(GDGPAN10)" /* display panel */
if (rc > 8) then do /* error? */
say 'Display error rc = 'rc'' /* yes- output message */
call dealloc /* dealloc PDS */
ADDRESS "ISPEXEC" "LIBDEF ISPPLIB" /* remove allocation */
exit(0) /* and quit */
end
ADDRESS "ISPEXEC" "REMPOP" /* remove pop-up */
Return
associations_notpres_display:
if substr(gdgbname,1,1) = '''' then do /* quoted DSN */
gdgbname= translate(gdgbname,' ','''') /* yes- remove them */
gdgbname= strip(gdgbname,b,' ') /* strip the spaces */
end
else
/*gdgbname= sysvar(sysuid)³³'.'³³gdgbname*//* move in HLQ */
ADDRESS "ISPEXEC" "ADDPOP ROW(2) COLUMN(1)" /* pop up position */
ADDRESS "ISPEXEC" "DISPLAY PANEL(GDGPAN11)" /* display panel */
if (rc > 8) then do /* error? */
say 'Display error rc = 'rc'' /* yes- output message */
call dealloc /* dealloc PDS */
ADDRESS "ISPEXEC" "LIBDEF ISPPLIB" /* remove allocation */
exit(0) /* and quit */
end
ADDRESS "ISPEXEC" "REMPOP" /* remove pop-up */
Return
obtain_gdg_base_name:
ADDRESS "ISPEXEC" "ADDPOP ROW(2) COLUMN(1)" /* pop up position */
ADDRESS "ISPEXEC" "DISPLAY PANEL(GDGPAN07)" /* display panel */
if (rc = 8) then do /* return? */
return /* yes- */
end
if (rc > 8) then do /* error? */
say 'Display error rc = 'rc'' /* yes- output message */
call dealloc /* dealloc PDS */
ADDRESS "ISPEXEC" "LIBDEF ISPPLIB" /* remove allocation */
exit(0) /* and quit */
end
ADDRESS "ISPEXEC" "REMPOP" /* remove pop-up */
Return
obtain_gdg_base_for_delete:
ADDRESS "ISPEXEC" "ADDPOP ROW(2) COLUMN(1)" /* pop up position */
ADDRESS "ISPEXEC" "DISPLAY PANEL(GDGPAN06)" /* display panel */
if (rc = 8) then do /* return? */
return /* yes- */
end
if (rc > 8) then do /* error? */
say 'Display error rc = 'rc'' /* yes- output message */
call dealloc /* dealloc PDS */
ADDRESS "ISPEXEC" "LIBDEF ISPPLIB" /* remove allocation */
exit(0) /* and quit */
end
ADDRESS "ISPEXEC" "REMPOP" /* remove pop-up */
Return
define_gdg_under_tso:
TEMP="'"³³DEFDSN³³"'"
defgdg= 'gdg (name('TEMP') limit('deflimit')'
if (defempty = 'Y') ³ (defempty = 'y') then
defgdg= defgdg³³' empty'
else
defgdg= defgdg³³' noempty'
if (defscr = 'Y') ³ (defscr = 'y') then
defgdg= defgdg³³' scratch'
else
defgdg= defgdg³³' noscratch'
if (defowner ª= ' ') then
defgdg= defgdg³³' owner('defowner'))'
else
defgdg= defgdg³³')'
address "TSO" "DEFINE "defgdg""
return
alter_gdg_under_tso:
altgdg= ' '
if (altlimit ª= ' ') then do
if (limit ª= altlimit) then
altgdg= altgdg³³' limit('altlimit')'
end
if (empty= 'EMPTY') & (altempty = 'N') then
altgdg= altgdg³³' noempty'
if (empty= 'NOEMPTY') & (altempty = 'Y') then
altgdg= altgdg³³' empty'
if (scratch= 'SCRATCH') & (altscr = 'N') then
altgdg= altgdg³³' noscratch'
if (scratch= 'NOSCRATCH') & (altscr = 'Y') then
altgdg= altgdg³³' scratch'
if (altgdg = ' ') then
return
TEMP="'"³³gdgbname³³"'"
altgdg= temp³³' '³³altgdg
address "TSO" "ALTER "altgdg""
return
delete_gdg_under_tso:
address "TSO" "DELETE '"gdgbname"'"
return
define_gdg_under_batch:
/* */
/* Build GDG Define Cards */
/* */
if substr(defdsn,1,1) = '''' then do /* quoted DSN? */
defdsn= translate(defdsn,' ','''') /* translate ''' to ' ' */
defdsn= strip(defdsn,b,' ') /* strip off blanks */
end
else
/*defdsn= sysvar(sysuid)³³'.'³³defdsn*//* add hlq */
jclstem.6= ' DEFINE GDG (NAME('defdsn') -'
jclstem.7= ' LIMIT('deflimit') -'
if (defempty = 'Y') ³ (defempty = 'y') then
jclstem.8= ' EMPTY -'
else
jclstem.8= ' NOEMPTY -'
if (defscr = 'Y') ³ (defscr = 'y') then
jclstem.9= ' SCRATCH -'
else
jclstem.9= ' NOSCRATCH -'
if (defowner ª= ' ') then
jclstem.10= ' OWNER('defowner'))'
else
jclstem.10= ' )'
stem_count= 5
call submit_job /* Submit the Batch Job */
return
alter_gdg_under_batch:
/* */
/* Build GDG Alter Cards */
/* */
if substr(gdgbname,1,1) = '''' then do /* quoted DSN? */
gdgbname= translate(gdgbname,' ','''') /* remove quotes */
gdgbname= strip(gdgbname,b,' ') /* strip blanks */
end
else
/*gdgbname= sysvar(sysuid)³³'.'³³gdgbname *//* append hlq */
i=6 /* Starting Number */
jclstem.i= ' ALTER -'
i= (i + 1)
jclstem.i= ' 'gdgbname' -'
i= (i + 1)
if (altlimit ª= ' ') then do
if (limit ª= altlimit) then do
jclstem.i= ' LIMIT('altlimit') -'
i= (i + 1)
end
end
if (empty= 'EMPTY') & (altempty = 'N') then do
jclstem.i= ' NOEMPTY -'
i= (i + 1)
end
if (empty= 'NOEMPTY') & (altempty = 'Y') then do
jclstem.i= ' EMPTY -'
i= (i + 1)
end
if (scratch= 'SCRATCH') & (altscr = 'N') then do
jclstem.i= ' NOSCRATCH -'
i= (i + 1)
end
if (scratch= 'NOSCRATCH') & (altscr = 'Y') then do
jclstem.i= ' SCRATCH -'
i= (i + 1)
end
if (i = 8) then /* Any Changes? */
return /* No- */
x= (i - 1) /* Re-position */
jclstem.x= translate(jclstem.x,' ','-') /* Convert '-' to ' ' */
stem_count= (i - 6) /* Calculate No Of Cards */
call submit_job /* Submit the Batch Job */
return
/* Return To Caller */
delete_gdg_under_batch:
if substr(gdgbname,1,1) = '''' then do /* quoted DSN? */
gdgbname= translate(gdgbname,' ','''') /* remove quotes */
gdgbname= strip(gdgbname,b,' ') /* strip blanks */
end
else
/*gdgbname= sysvar(sysuid)³³'.'³³gdgbname*/ /* add hlq */
jclstem.6= ' DELETE 'gdgbname' '
stem_count= 1 /* No of stems */
call submit_job /* Submit the Batch Job */
return
/* Return To Caller */
define_gdg_into_pds:
/* */
/* Build GDG Define Cards */
/* */
if substr(defdsn,1,1) = '''' then do /* quoted DSN? */
defdsn= translate(defdsn,' ','''') /* translate ''' to ' ' */
defdsn= strip(defdsn,b,' ') /* strip off blanks */
end
else
/* defdsn= sysvar(sysuid)³³'.'³³defdsn *//* add hlq */
record= ' DEFINE GDG (NAME('defdsn') -'
call putrec
record= ' LIMIT('deflimit') -'
call putrec
if (defempty = 'Y') ³ (defempty = 'y') then
record= ' EMPTY -'
else
record= ' NOEMPTY -'
call putrec
if (defscr = 'Y') ³ (defscr = 'y') then
record= ' SCRATCH -'
else
record= ' NOSCRATCH -'
call putrec
if (defowner ª= ' ') then
record= ' OWNER('defowner'))'
else
record= ' )'
call putrec
pdsmemb= 'GDG'³³gdef /* Construct PDS Member */
call stow /* Name And Stow Away */
gdef= gdef + 1 /* Next Member */
return
alter_gdg_into_pds:
if substr(gdgbname,1,1) = '''' then do
gdgbname= translate(gdgbname,' ','''')
gdgbname= strip(gdgbname,b,' ')
end
else
/* gdgbname= sysvar(sysuid)³³'.'³³gdgbname */
i=1 /* Starting Number */
jclstem.i= ' ALTER -'
i= (i + 1)
jclstem.i= ' 'gdgbname' -'
i= (i + 1)
if (altlimit ª= ' ') then do
if (limit ª= altlimit) then do
jclstem.i= ' LIMIT('altlimit') -'
i= (i + 1)
end
end
if (empty= 'EMPTY') & (altempty = 'N') then do
jclstem.i= ' NOEMPTY -'
i= (i + 1)
end
if (empty= 'NOEMPTY') & (altempty = 'Y') then do
jclstem.i= ' EMPTY -'
i= (i + 1)
end
if (scratch= 'SCRATCH') & (altscr = 'N') then do
jclstem.i= ' NOSCRATCH -'
i= (i + 1)
end
if (scratch= 'NOSCRATCH') & (altscr = 'Y') then do
jclstem.i= ' SCRATCH -'
i= (i + 1)
end
if (i = 3) then /* any changes required? */
return /* no- */
x= (i - 1) /* Re-position */
jclstem.x= translate(jclstem.x,' ','-') /* Convert '-' to ' ' */
do x = 1 to i-1 /* Write Records To PDS */
record= jclstem.x /* Transfer To Output Area*/
call putrec /* Call Output Routine */
end
pdsmemb= 'GDG'³³gdef /* Construct PDS Member */
call stow /* Name And Stow Away */
gdef= gdef + 1 /* Next Member */
return
delete_gdg_into_pds:
/* */
/* Build GDG delete Cards */
/* */
if substr(gdgbname,1,1) = '''' then do /* quoted DSN? */
gdgbname= translate(gdgbname,' ','''') /* remove quotes */
gdgbname= strip(gdgbname,b,' ') /* strip the blanks */
end
else
/* gdgbname= sysvar(sysuid)³³'.'³³gdgbname *//* insert hlq */
record= ' DELETE 'gdgbname' '
call putrec
pdsmemb= 'GDG'³³gdef /* Construct PDS Member */
call stow /* Name And Stow Away */
gdef= gdef + 1 /* Next Member */
return
delete_gdgents_under_bat:
c= 5 /* starting position */
do i= 1 to dsn.0 /* process all GDG assoc */
c= c + 1 /* next stem entry */
jclstem.c= ' DELETE 'dsn.i'' /* GDG DSN */
call obtain_volume_nos /* obtain device types */
if (substr(devtyp.1,7,2))= '20' then do /* DASD? */
iterate /* next one please */
end
if (substr(devtyp.1,7,2))= '80' then do /* tape? */
jclstem.c= jclstem.c³³' NOSCRATCH' /* GDG DSN */
iterate /* next one please */
end
end
stem_count= dsn.0 /* No of stems created */
call submit_job /* Submit the Batch Job */
return
delete_gdgents_into_pds:
do i= 1 to dsn.0 /* process all GDG assoc */
jclstem.i= ' DELETE 'dsn.i'' /* GDG DSN */
call obtain_volume_nos /* obtain device types */
if (substr(devtyp.1,7,2))= '20' then do /* DASD? */
iterate /* next one please */
end
if (substr(devtyp.1,7,2))= '80' then do /* tape? */
jclstem.i= jclstem.i³³' NOSCRATCH' /* GDG DSN */
iterate /* next one please */
end
end
do x = 1 to i-1 /* Write Records To PDS */
record= jclstem.x /* Transfer To Output Area*/
call putrec /* Call Output Routine */
end
delete_gdgents_under_tso:
do i= 1 to dsn.0 /* process all GDG assoc */
delgdge= dsn.i /* GDG DSN */
call obtain_volume_nos /* obtain device types */
ddsn= dsn.i /* display DSN to delete */
if (substr(devtyp.1,7,2))= '20' then do /* DASD? */
address "TSO" "DELETE '"delgdge"'" /* issue delete for DASD */
iterate /* next one please */
end
if (substr(devtyp.1,7,2))= '80' then do /* tape? */
address "TSO" "DELETE '"delgdge"' NOSCRATCH"
iterate /* next one please */
end
end
return
Submit_job:
DSN='GDGMAINT.JCL'
x= sysdsn(DSN)
if (x = 'OK') then /* yes */
address "TSO" "ALLOC FI(GDGJCL)
DA('"SYSVAR(SYSUID)".GDGMAINT.JCL(TEMP)') OLD"
else
address "TSO" "ALLOC FI(GDGJCL) /* no- full allocate */
DA('"SYSVAR(SYSUID)".GDGMAINT.JCL(TEMP)')
NEW RECFM(F B) DSORG(PO)
LRECL(80) BLKSIZE(8000) SPACE(1,1) DIR(1) CYLINDERS"
if (rc ª= 0) then do /* error? */
say 'Allocation Error rc = 'rc'' /* yes- output message */
call dealloc /* dealloc PDS */
ADDRESS "ISPEXEC" "LIBDEF ISPPLIB" /* remove allocation */
exit(0) /* and quit */
end
jclstem.0= (5 + stem_count)
jclstem.1= '//'SYSVAR(SYSUID)'1 JOB (MGT,MGT,MGTRAM,D2,ST99X),'GDGAPP','
jclstem.2= '// CLASS=B,MSGCLASS=R,NOTIFY='SYSVAR(SYSUID)' '
jclstem.3= '//IDCAMS EXEC PGM=IDCAMS'
jclstem.4= '//SYSPRINT DD SYSOUT=*'
jclstem.5= '//SYSIN DD *'
ADDRESS "TSO" "EXECIO "JCLSTEM.0" DISKW GDGJCL (STEM jclstem. FINIS"
ADDRESS "TSO" "FREE FI(GDGJCL)"
ADDRESS "TSO" "SUBMIT ('"SYSVAR(SYSUID)".GDGMAINT.JCL(TEMP)')"
return(0)
alloc_pds:
if (alloc_flag = 1) then /* PDS allocated */
return
x= sysdsn('GDGMAINT.PDS') /* check if DSN exists? */
if (x = 'OK') then /* yes */
address "TSO" "ALLOC FI(GDGMAINT)
DA('"SYSVAR(SYSUID)".GDGMAINT.PDS') OLD"
else
address "TSO" "ALLOC FI(GDGMAINT)
DA('"SYSVAR(SYSUID)".GDGMAINT.PDS')
NEW CYLINDERS RECFM(F B) LRECL(80) BLKSIZE(0)
SPACE(1 1) DIR(5)"
if (rc ª= 0) then do
say 'Cannot allocate file GDGMAINT. Return Code =' rc
address "ISPEXEC" "LIBDEF ISPPLIB"
exit(0)
end
alloc_flag = 1 /* PDS allocated */
return
initialise_Pds:
if (lmf_flag= 1) then /* LMF init? */
return /* Yes- */
address "ISPEXEC" "LMINIT DATAID("gdgpdef"),
DDNAME(gdgmaint),
ORG(ORGO),
ENQ(EXCLU)"
if (rc ª= 0) then do /* LIMIT okay? */
say zerrmsg zerrsm zerrlm /* No- issue err messages*/
ADDRESS "ISPEXEC" "LIBDEF ISPPLIB" /* remove allocation */
call dealloc /* Dealloc */
ADDRESS "ISPEXEC" "LIBDEF ISPPLIB" /* remove allocation */
exit(0)
end
address "ISPEXEC" "LMOPEN DATAID("gdgpdef"),
OPTION(OUTPUT)"
if (rc ª= 0) then do /* OPEN Okay? */
say zerrmsg zerrsm zerrlm /* No- Issue Err Messages*/
call dealloc /* Dealloc */
ADDRESS "ISPEXEC" "LIBDEF ISPPLIB" /* remove allocation */
exit(0)
end
lmf_flag= 1
return
putrec:
address "ISPEXEC" "LMPUT DATAID("gdgpdef"),
MODE(invar),
DATALOC(record),
DATALEN("reclen"),
NOBSCAN"
if (rc ª= 0) then do /* PUT Okay? */
say zerrmsg zerrsm zerrlm /* No- Issue Err Messages*/
call dealloc /* Dealloc */
ADDRESS "ISPEXEC" "LIBDEF ISPPLIB" /* remove allocation */
exit(0)
end
return
stow:
address "ISPEXEC" "LMMREP DATAID("gdgpdef"),
MEMBER("pdsmemb"),
STATS(no)"
if (rc = 0 ³ rc = 8) then /* REP Okay? */
nop /* Yes- */
else do
say zerrmsg zerrsm zerrlm /* Issue Error Messages */
call dealloc /* Dealloc */
ADDRESS "ISPEXEC" "LIBDEF ISPPLIB" /* remove allocation */
exit(0)
end
return
obtain_gdg_attributes:
x= outtrap("gdginfo.",'*',"noconcat") /* trap all listcat data */
ADDRESS "TSO" "LISTCAT ENT('"gdgbname"') GDG ALL"
if (rc ª= 0) then do /* listcat okay? */
gerr1= '----------------------------' /* No- Issues Error Mess */
gerr2= ' GDG Base Entry Not Found '
gerr3= '----------------------------'
ADDRESS "ISPEXEC" "ADDPOP ROW(4) COLUMN(10)"
ADDRESS "ISPEXEC" "DISPLAY PANEL(GDGPAN02)"
ADDRESS "ISPEXEC" "REMPOP"
rc= 4
return
end
limit= ' '
do i= 1 to gdginfo.0 /* obtain Data from lcat */
gdginfo.i= translate(gdginfo.i,' ','-') /* translate '-' to ' ' */
wpos= wordpos('LIMIT',gdginfo.i) /* check for LIMIT? */
if (wpos = 0) then /*found? */
iterate /* no- */
limit= word(gdginfo.i,2) /* get limit */
scratch= word(gdginfo.i,3) /* get scratch option */
empty= word(gdginfo.i,4) /* get empty option */
leave
end
obtain_gdg_information:
x= outtrap("gdginfo.",'*',"noconcat") /* trap listcat output */
ADDRESS "TSO" "LISTCAT ENT('"gdgbname"') GDG ALL"
if (rc ª= 0) then do /* non-zero from listcat */
gerr1= '----------------------------'
gerr2= ' GDG Base Entry Not Found '
gerr3= '----------------------------'
ADDRESS "ISPEXEC" "ADDPOP ROW(4) COLUMN(10)"
ADDRESS "ISPEXEC" "DISPLAY PANEL(GDGPAN02)"
ADDRESS "ISPEXEC" "REMPOP"
rc= 4
return
end
x= 0
do i= 1 to gdginfo.0 /* search for parameters */
gdginfo.i= translate(gdginfo.i,' ','-') /* translate '-' ti ' ' */
wpos= wordpos('DATASET OWNER',gdginfo.i) /* check for keyword? */
if (wpos = 0) then /* not found */
nop /* check the next keyword */
else do
dataown= word(gdginfo.i,3) /* data owner */
creation= word(gdginfo.i,5) /* creation date */
iterate /* go to do loop */
end
wpos= wordpos('EXPIRATION',gdginfo.i) /* check for keyword? */
if (wpos = 0) then /* not found */
nop
else do
expiron= word(gdginfo.i,4) /* expiration date */
iterate /* go to do loop */
end
wpos= wordpos('LIMIT',gdginfo.i) /* check for keyword? */
if (wpos = 0) then /* not found */
nop
else do
limit= word(gdginfo.i,2) /* limit */
scratch= word(gdginfo.i,3) /* scratch */
empty= word(gdginfo.i,4) /* empty */
iterate
end
wpos= wordpos('NONVSAM ',gdginfo.i) /* check for keyword? */
if (wpos = 0) then /* not found */
nop
else do
x= x + 1 /* next stem entry */
dsn.x= word(gdginfo.i,2) /* DSN */
iterate
end
end
dsn.0= x /* set no entries in stem */
rc= 0 /* set return code */
return
obtain_volume_nos:
x= outtrap("volinfo.",'*',"noconcat") /* trap listcat output */
ADDRESS "TSO" "LISTCAT ENT('"dsn.i"') ALL"
if (rc ª= 0) then do /* listcat okay? */
rc= 4 /* no- set return code */
return
end
x= 0 /* init */
do y= 1 to volinfo.0 /* scan listcat output */
volinfo.y= translate(volinfo.y,' ','-') /* translate '-' to ' ' */
wpos= wordpos('VOLSER ',volinfo.y) /* keyword? */
if (wpos = 0) then /* found keyword? */
nop /* no- */
else do
x= (x + 1) /* next stem entry */
vol.x= word(volinfo.y,2) /* volume */
devtyp.x= word(volinfo.y,4) /* device type */
iterate
end
end
vol.0= x /* set no stem entries */
devtyp.0= x /* set no stem entries */
rc= 0 /* set the return code */
return
build_gdgdsn_table:
if (dsn.0 = 0) then /* Any DSN info? */
return /* No */
ADDRESS "ISPEXEC" "TBCREATE GDSNTAB NOWRITE REPLACE"
if (rc > 4) then do /* call okay? */
say 'tbcreate error rc = 'rc'' /* no- inform the user */
call dealloc /* Dealloc */
ADDRESS "ISPEXEC" "LIBDEF ISPPLIB" /* remove allocation */
exit(0) /* lets quit */
end
ztdmark= '-----------------------------------------------------------
----------------'
ADDRESS "ISPEXEC" "VPUT (PPTENTRY,ZTDMARK) SHARED"
tabrows= 9999 /* max table rows */
do i= 1 to dsn.0 /* build DSN tab */
gdgdsn= dsn.i /* GDG DSN name */
call obtain_volume_nos /* obtain the volume nos */
if (rc ª= 0) then do /* rc > 0? */
volume= ' ' /* set to blanks */
ADDRESS "ISPEXEC" "TBADD GDSNTAB /* add the entries */
SAVE(gdgdsn,volume)
MULT("TABROWS")"
if (rc ª= 0) then do /* call okay? */
say 'tbadd error rc = 'rc'' /* no- inform the user */
call dealloc /* Dealloc */
ADDRESS "ISPEXEC" "LIBDEF ISPPLIB" /* remove allocation */
exit(0) /* lets quit */
end
iterate /* next DSN entry */
end
do y= 1 to vol.0 /* build volume nos */
volume= vol.y /* volume serial no */
ADDRESS "ISPEXEC" "TBADD GDSNTAB /* add the entries */
SAVE(gdgdsn,volume)
MULT("TABROWS")"
if (rc ª= 0) then do /* call okay? */
say 'tbadd error rc = 'rc'' /* no- inform the user */
call dealloc /* Dealloc */
ADDRESS "ISPEXEC" "LIBDEF ISPPLIB" /* remove allocation */
exit(0) /* lets quit */
end
gdgdsn= ' ' /* reset */
end
end
ADDRESS "ISPEXEC" "TBTOP GDSNTAB" /* position to top of tab */
if (rc ª= 0) then do /* call okay? */
say 'tbtop error rc = 'rc'' /* no- inform the user */
ADDRESS "ISPEXEC" "LIBDEF ISPPLIB" /* remove allocation */
call dealloc /* Dealloc */
exit(0) /* lets quit */
end
return
table_close:
ADDRESS "ISPEXEC" "TBCLOSE GDSNTAB" /* Close The Table */
if (rc ª= 0) then do /* call okay? */
say 'tbtop error rc = 'rc'' /* no- inform the user */
ADDRESS "ISPEXEC" "LIBDEF ISPPLIB" /* remove allocation */
call dealloc /* Dealloc */
exit(0) /* lets quit */
end
return
dealloc:
if (lmf_flag = 1) then do
address "ISPEXEC" "LMCLOSE DATAID("gdgpdef")"
address "ISPEXEC" "LMFREE DATAID("gdgpdef")"
end
if (alloc_flag = 1) then
address "TSO" "FREE FILE(GDGMAINT)"
return
GDGPAN11.txt