ca.portal.admin

Re:[IDMS-L] out of the closet: PDS Muncher

Discussion created by ca.portal.admin on Jun 28, 2006
ever wanted to empty a pds without deleting it? Well I have, and did not
want to manually delete 1000+ members ... here is something I threw
together to accomplish the task:

gets a list of members
formats the list
deletes the members from the pds
frees up directory space in the PDS

requires CA-CULPRIT (of course)


//STEP0001 EXEC PGM=IEHLIST,PARM='LINECNT=99'
//SYSPRINT DD DSN=&&WORK01,DISP=(NEW,PASS),UNIT=SYSDA,
// DCB=(RECFM=FBA,LRECL=121,BLKSIZE=27951),
// SPACE=(TRK,(1,1),RLSE)
//DDNAME1 DD DISP=SHR,VOL=SER=volser,UNIT=SYSDA
//SYSIN DD *
LISTPDS DSNAME=dsn,VOL=SYSDA=volser
//STEP0002 EXEC CULPPROC
//INF DD DSN=&&WORK01,DISP=(OLD,DELETE)
//OFA DD DSN=&&WORK02,DISP=(NEW,PASS),
// DCB=(RECFM=FB,LRECL=080,BLKSIZE=27920),
// SPACE=(CYL,(1,1),RLSE)
//SYSIN DD *
IN 121 F PS DD=INF
REC DIRECTORY-LIT 003 009
REC I-VOLSER 043 006
REC I-DSNAME 002 045
REC BYTE-TABLE 002 GROUP BY 1.45
REC BYTE 001 001 ELMNT BY
REC I-MEMBER-NAME 012 009
REC I-COL-12 012 001
REC I-COL-13 013 001
REC I-COL-14 014 001
REC I-COL-15 015 001
REC I-COL-16 016 001
REC I-COL-17 017 001
REC I-COL-18 018 001
REC I-COL-19 019 001
REC I-COL-20 020 001
010 HOLD-VOLSER '******'
010 HOLD-DSNAME '*********************************************'
010 FLAG 'N'
010 DIRECTORY-VALUE 'DIRECTORY'
010 SUB1 0
01OUT 080 D PS DD=OFA
01SORT NOSORT
01510002 'SCRATCH DSNAME='
01510017 HOLD-DSNAME SZ=045
01510072 'X'
01520016 'VOL=SYSDA=('
01520027 HOLD-VOLSER SZ=006
01520033 '),'
01520072 'X'
01530016 'MEMBER='
01530023 I-MEMBER-NAME SZ=008
017 IF FLAG NE 'Y' 010
017 MOVE 45 TO SUB1
017005 SUB1 - 1 SUB1
017 IF SUB1 EQ 0 STOP
017 IF BYTE.SUB1 LE ' ' 005
017 SUB1 + 1 SUB1
017 CALL US43 (',' BYTE.SUB1 1)
017 MOVE I-DSNAME TO HOLD-DSNAME
017 MOVE 'N' TO FLAG
017 DROP
017010 IF DIRECTORY-LIT NE DIRECTORY-VALUE 020
017 MOVE I-VOLSER TO HOLD-VOLSER
017 MOVE 'Y' TO FLAG
017 DROP
017020 IF I-COL-12 LE ' ' DROP <===== i am sure there is a
better
way to avoid unwanted lines, i will find it someday
017 IF I-COL-12 EQ '0' DROP
017 IF I-COL-12 EQ '.' DROP
017 IF I-COL-13 EQ '.' DROP
017 IF I-COL-14 EQ ('.' ' ') DROP
017 IF I-COL-15 EQ '.' DROP
017 IF I-COL-16 EQ '.' DROP
017 IF I-COL-17 EQ '.' DROP
017 IF I-COL-18 EQ '.' DROP
017 IF I-COL-19 EQ '.' DROP
017 IF I-MEMBER-NAME EQ 'LV' TAKE
017 DROP
//STEP0003 EXEC PGM=IEHPROGM
//LOADLIB DD DSN=dsn,DISP=SHR
//SYSPRINT DD SYSOUT=*
//SYSIN DD DSN=&&WORK02,DISP=(OLD,DELETE)
//STEP0004 EXEC PGM=IEBCOPY
//SYSUT1 DD DISP=SHR,DSN=dsn
//SYSUT2 DD DISP=SHR,DSN=dsn
//SYSUT3 DD UNIT=SYSDA,SPACE=(TRK,(1))
//SYSUT4 DD UNIT=SYSDA,SPACE=(TRK,(1))
//SYSPRINT DD SYSOUT=*
//SYSIN DD DUMMY






Chris Hoelscher
IDMS & DB2 Database Administrator
Humana Inc
502-710-3038
choelscher@humana.com




The information transmitted is intended only for the person or entity to
which it is addressed and may contain CONFIDENTIAL material. If you
receive this material/information in error, please contact the sender
and delete or destroy the material/information.

"
IDMS Public Discussion Forum
IDMS-L@LISTSERV.IUASSN.COM
SMTP
IDMS-L@LISTSERV.IUASSN.COM
IDMS-L@LISTSERV.IUASSN.COM
SMTP








Normal

Normal
Re: PTF QO78461
"Hal,

As a 16.0 SP1 shop I got the okay about QO78460 and QO79307. I asked
Louis Auger and Peter Van de Ven who posted on May 11th. You should need
QO79308 along with QO78461.

Chris Wood
Alberta Department of Energy
CANADA

Outcomes