/*--rexx- show vtoc of a volume.  optional parm is volume name ---*/
Address 'ISPEXEC'
'CONTROL ERRORS CANCEL'
Call setup_libdefs                   /* Create panel/message library */
arg zddnvol .                        /* get vol name from passed parm*/
if zddnvol='' then zddnvol='PRM903'  /* if none, use a default       */
'VPUT ZDDNVOL SHARED'                /* set up for panel logic       */
zddnskp='0'
'SELECT PGM(ISRUDL) PARM(UDLP)'      /* Call ISPF for VTOC display   */
Call destroy_libdefs                 /* Clean up temp library        */
Return 1                             /* Return with cursor on cmdline*/
/********************** setup_libdefs ********************************/
setup_libdefs: Procedure Expose ddname /* Create and populate temp   */
                                       /* data set and libdef to it  */
 
ddname = '$'right(time(s),7,'0')     /* create unique ddname         */
Address tso 'ALLOC NEW DEL F('ddname') DIR(1) SP(1) TR RECF(F B)
             BLKS(0) LRECL(80) REU'  /* Allocate data set            */
Address ispexec
'LMINIT DATAID(DID) DDNAME('ddname') ENQ(EXCLU)'
'LMOPEN DATAID(&DID) OPTION(OUTPUT)'
a=1
Do a=a to 999 Until substr(line,1,8)='/*MEMBER'
  line = sourceline(a)
End
Parse Var line . memname .
Do a=a+1 to 999 While substr(line,1,2) \= '*/'
  line = sourceline(a)
  'LMPUT DATAID(&DID) MODE(INVAR) DATALOC(LINE) DATALEN(80)'
End
'LMMADD DATAID(&DID) MEMBER(&MEMNAME)'
'LMFREE DATAID(&DID)'
'LIBDEF ISPPLIB LIBRARY ID('ddname') STACK' /* LIBDEF panels         */
Return
 
/************************ DESTROY_LIBDEFS ***************************/
destroy_libdefs:
  Address ispexec 'LIBDEF ISPPLIB '  /* Remove Panels libdef         */
  Address tso 'FREE F('ddname')'     /* Free and delete temp file    */
  Return
 
/*------------------------------------------------------------------*/
/* In-line panels and messages are defined below                    */
/*------------------------------------------------------------------*/
 
/*MEMBER UDLP   This is a panel to prompt user for line length.
)ATTR
 ? type(output)
)BODY cmd()
_ZCMD      +?ZDLPVL+
)INIT
VGET (ZDDNVOL) SHARED
&ZCMD = &Z
&ZUOPT = 'V'
&ZDLPVL = &ZDDNVOL
IF (&ZDDNSKP NE '1') .RESP = ENTER
ELSE .RESP = END
&ZDDNSKP = '1'
)REINIT
.RESP = END
)PROC
)END
*/