/* REXX */
/* Edit macro to compress a pds on the fly */
/* Paul Lemons taltyman@excite.com */
/* Copy this member into a library in your TSO ISPF sysproc concatenation */
'ISREDIT MACRO (HELP) PROCESS'
TRACE OFF
'ISREDIT (DSN) = DATASET'
IF HELP = ? THEN DO
ZEDSMSG = 'COMPRESS - PRESS PF1'
ZEDLMSG = 'THIS WILL PERFORM A SHARED COMPRESS IN PLACE ON' DSN
"ISPEXEC SETMSG MSG(ISRZ001)"
RETURN
END
DSNX = SPACE("'" DSN "'",0)
Y = LISTDSI(DSNX)
IF SYSDSORG ¬= 'PO' THEN DO
ZEDSMSG = 'DSORG ERROR - PRESS PF1'
ZEDLMSG = 'INVALID DATASET ORGANIZATION - MUST BE PO'
"ISPEXEC SETMSG MSG(ISRZ001)"
RETURN
END
OLDUSED = SYSUSED
STAT = MSG('OFF')
'FREE F(SYSUT1 SYSUT2 SYSUT3 SYSUT4)'
'FREE F(SYSIN SYSPRINT)'
'ALLOC F(SYSUT3) NEW'
'ALLOC F(SYSUT4) NEW'
'ALLOC F(SYSUT1) DA('''DSN''') SHR'
'ALLOC F(SYSUT2) DA('''DSN''') SHR'
"ALLOC F(SYSIN) DUMMY"
OUTDSN = SPACE(SYSVAR('SYSUID') .COMPRESS.LIST,0)
OUTDSN = SPACE("'" OUTDSN "'",0)
X = SYSDSN(OUTDSN)
IF X ¬= OK THEN
"ALLOC F(SYSPRINT) DA("OUTDSN") NEW SPACE(1,1) TRACK LRECL(80) RECFM(F)"
ELSE "ALLOC F(SYSPRINT) DA("OUTDSN") SHR"
IF RC ¬= 0 THEN DO
ZEDSMSG = 'ERR CODE' RC '- PRESS PF1'
MSG1 = INTERNAL ERROR HAS OCCURRED ALLOCATING THE SYSPRINT FILE
MSG2 = OUTDSN
ZEDLMSG = MSG1 MSG2
"ISPEXEC SETMSG MSG(ISRZ001)"
RETURN
END
STAT = MSG('ON')
"CALL 'SYS1.LINKLIB(IEBCOPY)'"
IF RC = 0 THEN DO
"ISREDIT LINE_AFTER 0 = NOTELINE '"DSN" COMPRESSED'"
ZEDSMSG = 'RET CODE' RC '- PRESS PF1'
LW = LINESIZE()
IF LW < 80 THEN LW = 74
ELSE LW = 84
HLW = LW / 2
HLW = FORMAT(HLW,2,0)
Y = LISTDSI(DSNX DIRECTORY)
MSG1 = LEFT('DATASET NAME :' DSN 'VOLSER :' SYSVOLUME,LW,' ')
MSG2 = LEFT('PRIMARY ALLOC.:' SYSPRIMARY SYSUNITS'(S)',HLW,' ')
MSG3 = LEFT('SECONDARY :' SYSSECONDS SYSUNITS'(S)',HLW,' ')
MSG4 = LEFT('ALLOCATED :' SYSALLOC SYSUNITS'(S)',HLW,' ')
MSG5 = LEFT('USING :' SYSUSED 'WAS :' OLDUSED SYSUNITS'(S)',HLW,' ')
MSG6 = LEFT('DIR BLKS USED :' SYSUDIRBLK OUT OF SYSADIRBLK,HLW,' ')
MSG7 = LEFT('MEMBERS :' SYSMEMBERS,HLW,' ')
MSG8 = LEFT('BLOCK SIZE :' SYSBLKSIZE,HLW,' ')
MSG9 = LEFT('LAST REFERENCE:' SYSREFDATE,HLW,' ')
MSGA = CENTER('> 'BROWSE OUTDSN FOR COMPRESS OUTPUT LISTING' <',LW,'=')
MSGB = LEFT('KOMPRESS V1R1 : TaltyMan@excite.com ',LW,' ')
ZEDLMSG = MSGA MSG1 MSG2 MSG3 MSG4 MSG5 MSG6 MSG7 MSG8 MSG9 MSGB
END
ELSE DO
ZEDSMSG = 'RET CODE' RC '- PRESS PF1'
ZEDLMSG = KOMPRESS INTERNAL ERROR OCCURRED HAS OCCURRED
END
"ISPEXEC SETMSG MSG(ISRZ001)"
STAT = MSG('OFF')
'FREE F(SYSUT1 SYSUT2 SYSUT3 SYSUT4)'
'FREE F(SYSIN SYSPRINT)'
STAT = MSG('ON')
RETURN