/* REXX */
trace o
address ispexec "control errors return"
address ispexec
  "libdef ispplib dataset id('HLQ.sysmd.isppdeu') cond"
  "libdef ispslib dataset id('HLQ.sysmd.ispslib') cond"

/* ermitteln letzes gdg */
 gdg = "HLQ.DRUCK.PTFLIST.ALLSYS"
 x = outtrap(dsn.)
 address tso
 "listc level("gdg")"
 v=dsn.0-1;edit=0
 do i=1 to v
     pre=substr(dsn.i,1,7)
     name=substr(dsn.i,16,44)
     name=strip(name)
     if pre="NONVSAM" then ptflist=name
 end
/* alloc input and temp file  */
 "alloc fi(ptflist) ds('"ptflist"') shr reuse"
 "alloc fi(ptftemp) new reu delete space(5,3) cyl dsorg(ps)
       recfm(f b) lrecl(80) unit(sysda)"
/* lminit for edit temp file */
 address ispexec "lminit ddname(ptftemp) dataid(ptftemp)"
 tabl="PTFTAB0";tc=0;
 panl="PTFPAN01";
 address ispexec "tbend" tabl
 address ispexec "tbopen" tabl
 if rc=8 then call create_table

 address ispexec "tbvclear" tabl
 ptf="*";img="*";prg="*";mod="*";dat="*";lib="*";
 ptx="*";imx="*";prx="*";mox="*";
/* call update_table */
/* main procedure ----------------------------------------------------*/
 do forever
   address ispexec "tbsarg" tabl
   address ispexec "tbsort" tabl "fields(ptf,c,a,img,c,a)"
   address ispexec "tbtop" tabl
   address ispexec "tbdispl" tabl "panel("panl")"
   if rc=8 then call exit_routine
   upper zcmd
   if zcmd="E" then call edit_routine
   if zcmd="P" then call print_routine
   if zcmd="T" then call update_table

   if ptx/="*" then ptf=ptx"*"
   else ptf="*"
   if imx/="*" then img=imx"*"
   else img="*"
   if prx/="*" then prg=prx"*"
   else prg="*"
   if mox/="*" then mod=mox"*"
   else mod="*"
   if lix="TEST" then lib="SYS1.TEST*"
   else lib="*"
   dat="*"
   if ptf/="*" ! img/="*" then panl="ptfpan02"
 end
/* subroutines -------------------------------------------------------*/
create_table:
 address ispexec "tbcreate ptftab0 names(ptf img prg mod dat lib)" ,
                 "write replace"
 say "create table - please wait"
 do forever
   "execio 1 diskr ptflist"
   if rc>0 then leave
   parse pull line
   ptf = word(line,1)
   img = word(line,2)
   prg = word(line,3)
   mod = word(line,4)
   dat = word(line,5)
   lib = word(line,6)
   address ispexec "tbadd ptftab0"
 end
 "execio 0 diskr ptflist(finis"
 address ispexec "tbsave ptftab0"
return

update_table:
 say "update table - please wait"
 do forever
    address ispexec "tbskip ptftab0"
    if rc>0 then leave
    address ispexec "tbdelete ptftab0"
 end
 address ispexec "vget (zdate)"
 address ispexec "tbcreate ptftab0 names(ptf img prg mod dat lib)" ,
                 "write replace"
 say "create table - please wait"
 do forever
   "execio 1 diskr ptflist"
   if rc>0 then leave
   parse pull line
   ptf = word(line,1)
   img = word(line,2)
   prg = word(line,3)
   mod = word(line,4)
   dat = word(line,5)
   lib = word(line,6)
   address ispexec "tbadd ptftab0"
 end
 "execio 0 diskr ptflist(finis"
 address ispexec "tbsave ptftab0"
 update=zdate
 address ispexec "vput (update) profile"
return

edit_routine:
 if edit<1 then
 do
    say "create tempf - please wait"
    do forever
      "execio 1 diskr ptflist"
      if rc>0 then leave
      parse pull line
      queue line
      "execio 1 diskw ptftemp"
    end
    "execio 0 diskw ptftemp(finis"
    "execio 0 diskw ptflist(finis"
 end
 address ispexec "edit dataid("ptftemp") panel(ptfeditp)"
 edit=1
return

print_routine:
  /* alloc temp file for print */
   address ispexec "vget (zprefix ztempf)"
   ptfds=zprefix".PTFLIST.TEMP"
   "delete ('"ptfds"') nvsam"
   "alloc fi(ptftemp) ds('"ptfds"') new reu catalog space(3,3)" ,
   "cyl dsorg(ps) recfm(F B A) lrecl(80) blksize(80) unit(sysda)"

   out.1 = " PTF      Sys  Loadlib"
   queue out.1
   out.2 = " --------+----+---------------------------------"
   queue out.2
   count=2
   do forever
      address ispexec "tbscan" tabl
      if rc>0 then leave
      address ispexec "tbget" tabl
      count=count+1
      ptf=left(ptf,8)
      out.count=" "ptf img lib
      say out.count
      queue out.count
   end
   do x=1 to count
      "execio 1 diskw ptftemp"
   end
   "execio 0 diskw ptftemp(finis"
   address ispexec "edit dataset("ptfds")"
   address ispexec "display panel(ptfdruck)"
   "free fi(ptftemp)"
   address ispexec
    "ftopen temp"
    "ftincl ptfskel1"
    "ftclose"
    if zprefix = " " then
       xtempf = ztempf
    else
       xtempf = "'"ztempf"'"
    if editj="N" then
       address tso "submit" xtempf
    else
       address ispexec "edit dataset("xtempf")"
return

exit_routine:
trace r
   address ispexec "tbclose ptftab0"
   "free fi(ptftemp)"
   "free fi(ptflist)"
   address ispexec
     "libdef ispplib"
     "libdef ispslib"
exit