/* PROFDUMP Rexx - Dump the contents of current profile to a file    */
/* Version 1.1  - allow other profiles including ISPSPROF            */
/* Syntax: TSO PROFDUMP dsn prof                                     */
/*           dsn is required - it will be deleted and reallocated.   */
/*           prof is the applid to be searched (ISR, ISP, ISPS, etc) */
/*           prof is optional and will default to the current applid.*/
Parse Arg dsn appl .
If dsn='' Then
  Do
    Say 'NO DUMP DATA SET GIVEN '
    Exit
  End
'ALLOC F(FOOBAR) DA('dsn') MOD DEL UNIT(SYSDA) REU'
'ALLOC F(FOOBAR) DA('dsn') NEW CAT TR SPA(20,20) RELEASE REUSE',
  'DSORG(PS) RECFM(V B) LRECL(500) BLKSIZE(0) UNIT(SYSDA)'
Do queued()
  Pull
End                                    /* JUST IN CASE               */
Address ispexec
'CONTROL ERRORS RETURN'
'VGET ZAPPLID'
parse upper value appl zapplid with appl .
tablenam=appl'PROF'
'TBTOP ' tablenam
'TBSKIP' tablenam 'NUMBER(1) SAVENAME(SAVES)'
say skip rc
Parse Var saves'('saves')'
Queue tablenam': TOTAL VARIABLES:' words(saves)
Queue copies('-',length(tablenam': TOTAL VARIABLES:' words(saves)))
tlen=0
Do While saves \= ''
  Parse Var saves word saves
  'VGET 'word' PROFILE'
  Interpret 'LEN = LENGTH('word')'
  tlen=tlen+len
  Interpret 'VAL = 'word
  Queue left(word,9)right(len,5)' 'val
End
Queue 'Total variable lengths: 'tlen
Address tso
'EXECIO 'queued()' DISKW FOOBAR (FINIS'
'FREE F(FOOBAR)'
Do queued()
  Pull
End /* JUST IN CASE */