/*                                                                    rexx
 Set/update ISPF source library member statistics
 Syntax: UPDSTAT dsn(mbr)
 You may run the program from ISPF 3.4 memberlist.
 The program is self-contained, it has the panel in-line.
*/

 parse value '0 0' with acti acto libdd mbrdd zerrlm
 address ispexec
 "control errors return"

 arg ds
 parse value strip(ds,"b","'") with dsn '(' mbr ')' .
 if dsn='' | mbr='' then ,
   Call close 'Datasetname / membername missing'

 "lminit dataid(did1) dataset('"dsn"') enq(shrw) org(ov)"
 if rc<>0 then call close 'LMInit' dsn 'rc' rc zerrlm
 if ov<>'PO' then call close 'Not a library'
 acti=1   /* init done */
 "lmopen dataid("did1") option(input) recfm(rfm)"
 if rc<>0 then call close 'LMOpen' dsn 'rc' rc zerrlm
 if rfm='U' then call close 'Cannot set status for a loadlib'
 acto=1   /* open done */
 "lmmfind dataid("did1") member("mbr") stats(yes)"
 if rc<>0 then call close 'LMmfind' dsn mbr 'rc' rc zerrlm

 $ext=zlext
 if zlext='YES' then $cnorc=zlcnorce
 else                $cnorc=zlcnorc
 if zlext='YES' then $inorc=zlinorce
 else                $inorc=zlinorc
 $mtime=zlmtime':'zlmsec
 $cdate=zlc4date
 $mdate=zlm4date
 $user =zluser
 $vers =zlvers
 $mod  =zlmod
 address tso
 cc=bpxwdyn('alloc new delete',
            'lrecl(80) recfm(f,b) blksize(4080)',
            'tracks space(1,1) dir(1) unit(sysallda)',
            'rtddn(libdd) rtdsn(libds)')
 if cc<>0 then call close "alloc worklib rc" cc
 cc=bpxwdyn('alloc old da('libds'('libdd')) rtddn(pnldd)')
 if cc<>0 then call close "alloc panel mbr rc" cc
 pnl=libdd
 "newstack"
 queue  ")ATTR                                              "
 queue  "+ type(text) color(green) skip(on)                 "
 queue  "% type(text) color(white) skip(on)                 "
 queue  "# type(text) color(blue ) skip(on)                 "
 queue  "_ type(input ) color(turq) hilite(uscore) caps(on) "
 queue  "! type(output) color(turq) caps(off)               "
 queue  ")BODY EXPAND(\\)                                   "
 queue  "%\ \Set member status\ \+                          "
 queue  "%Cmd =>_zcmd \ \                                   "
 queue  "+                                                  "
 queue  "+                                                  "
 queue  "+Dataset!dsmb\ \+                                  "
 queue  "+                                                  "
 queue  "+                                                  "
 queue  "+Cretion date         _$cdate    #YYYY/MM/DD       "
 queue  "+Modify date          _$mdate    #YYYY/MM/DD       "
 queue  "+       time          _$mtime  #  HH:MM:SS         "
 queue  "+User                 _$user   +                   "
 queue  "+Current no of records_$cnorc    +                 "
 queue  "+Initial no of records_$inorc    +                 "
 queue  "+Version              _z +                         "
 queue  "+Modification level   _z +                         "
 queue  "+                                                  "
 queue  "#\ \Hit ENTER to update, END/RETURN to cancel\ \+  "
 queue  "#\ \Note, you must modify at least one field\ \+   "
 queue  ")INIT                                              "
 queue  " .zvars = '($vers $mod)'                           "
 queue  ")PROC                                              "
 queue  ")END                                               "
 "execio" queued() "diskw" pnldd "(finis)"
 cc=rc
 "delstack"
 zz=Bpxwdyn('free dd('pnldd')')
 pnldd=''
 if cc<>0 then call close 'panel write rc' cc

 address ispexec
 "libdef ispplib library id("libdd") stack"
 dsmb=dsn'('mbr')'
 before=space($cdate $mdate $mtime $user $vers $mod $cnorc $inorc)
 do forever
   "display panel("pnl")"
   if rc>8 then call close 'panel error rc' rc zerrlm
   if rc>0 then call close
   if space($cdate $mdate $mtime $user $vers $mod $cnorc $inorc)<>before,
     then leave
 end

 /* Update */
 p=''
 if $cdate<>'' then p=p 'created4('$cdate')'
 if $mdate<>'' then p=p 'moddate4('$mdate')'
 if $mtime<>'' then p=p 'modtime('$mtime')'
 if $user<>''  then p=p 'user('$user')'
 if $vers<>''  then p=p 'version('$vers')'
 if $mod <>''  then p=p 'modlevel('$mod')'
 if $cnorc<>'' then p=p 'cursize('$cnorc')'
 if $inorc<>'' then p=p 'initsize('$inorc')'
 if $ext='YES' then p=p 'ext(YES)'
 "lmmstats dataid("did1") member("mbr")" p
 Call Close 'Update' dsn mbr 'rc' rc zerrlm

Close:
 if pnldd<>''  then cc=Bpxwdyn('free dd('pnldd')')
 if libdd<>''  then address ispexec "libdef ispplib"
 if libdd<>''  then cc=Bpxwdyn('free dd('libdd')')
 if acto       then address ispexec 'lmclose dataid('did1')'
 if acti       then address ispexec 'lmfree dataid('did1')'
 if arg(1)<>'' then call xmsg arg(1)
 exit 0
XIsp: address ispexec arg(1);return rc
XMsg:
 parse arg zedlmsg,cc
 address ispexec "vput zedlmsg"
 address ispexec "setmsg msg(isrz000)"
 return word(cc 0,1)