zOs/REXX.O13/PVSLOG
call adrTso 'alloc dd(in) shr reuse dsn(WK.TEXTVB(PTAEXT)'
call adrTso 'alloc dd(out) shr reuse dsn(WK.TEXTVB(sum)'
call readDDBegin in
call writeDDBegin out
ox = 0
begCnt = 0
endCnt = 0
do while readDD(in, r.)
do r=1 to r.0
cx = pos("CURRENT DATE IS", r.r)
if cx > 0 then do
da = space(substr(r.r, cx + 15))
if right(word(da, 1), 1) == "," then do
da = word(da, 2) ,
translate(left(word(da, 3), 1)) ,
|| translate(substr(word(da, 3), 2) ,
, 'abcdefghijklmnopqrstuvwxyz' ,
, 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'),
word(da, 4)
da = date('s', da, 'n')
end
else do
da = word(da, 1)
if length(da) == 10 then
da = left(da,6)right(da, 2)
da = date('s', da, 'e')
end
da = right(da, 2)'.'substr(da, 5, 2)'.'left(da, 4)
say 'date' da
iterate
end
ti = substr(r.r, 2, 8)
id = substr(r.r, 12, 8)
if id == 'PVS2021 ' then do
begCnt = begCnt + 1
end
else if id == 'PVS2022 ' then do
endCnt = endCnt + 1
if substr(r.r, 53, 6) ^= 'PVSR#=' then
call err 'bad end Rec': r.r
pvsR.endCnt = word(substr(r.r, 59), 1)
end
else if id == 'PVS2025 ' then do
endCnt = endCnt + 1
pvsR.endCnt = 00000000
end
else if id == ' DSN ' then do
dsn = word(substr(r.r, 23), 1)
if substr(dsn, 3, 1) == 'S' then
dsn = overlay('R', dsn, 3)
if symbol('m.beg.dsn') == 'VAR' then do
if endCnt <= 0 then do
say 'ignoring' r.r
end
else do
if endCnt > 1 then do
e1 = endCnt - 1
say 'endCnt' endCnt pvsR.endCnt pvsR.e1 dsn
end
ox = ox + 1
o.ox = m.beg.dsn','ti da','pvsR.endCnt','dsn
drop m.beg.dsn
endCnt = endCnt - 1
end
end
else if begCnt > 0 then do
m.beg.dsn = ti da
begCnt = begCnt - 1
end
end
end
if ox > 100 then do
call writeDD out, o., ox
ox = 0
end
end
if begCnt ^= 0 | endCnt ^= 0 then
call err 'at end begCnt' begCnt 'endCnt' endCnt
if ox > 0 then do
call writeDD out, o., ox
ox = 0
end
call readDDEnd in
call writeDDEnd out
exit
err:
parse arg ggMsg
call errA ggMsg
exit 12
endSubroutine err
/* copy adr begin ****************************************************/
/*--- format dsn from tso format to jcl format -----------------------*/
dsn2jcl: procedure
parse arg dsn .
if left(dsn,1) = "'" then
return strip(dsn, 'b', "'")
else if sysvar('SYSPREF') = '' then
return dsn
else
return sysvar('SYSPREF')'.'dsn
endProcedure dsn2Jcl
/*--- format dsn from jcl format to tso format -----------------------*/
dsnFromJcl: procedure
parse arg dsn .
return "'"dsn"'"
endProcedure dsnFromJcl
/**********************************************************************
io: read or write a dataset with the following callsequences:
read: readDDBegin, readDD*, readDDEnd
write: writeBegin, writeDD*, writeEnd
readDD returns true if data read, false at eof
***********************************************************************/
/*--- prepare reading from a DD --------------------------------------*/
readDDBegin: procedure
return /* end readDDBegin */
/*--- read from DD ggDD into ggSt, return false at eof ---------------*/
readDD:
parse arg ggDD, ggSt, ggCnt
if ggCnt = '' then
ggCnt = 100
call adrTso 'execio' ggCnt 'diskr' ggDD '(stem' ggSt')', 2
return (value(ggSt'0') > 0)
return /* end readDD */
/*--- finish reading DD ggDD ----------------------------------------*/
readDDEnd: procedure
parse arg ggDD
call adrTso 'execio 0 diskr' ggDD '(finis)'
return /* end readDDEnd */
/*--- prepare writing to DD ggDD -------------------------------------*/
writeDDBegin: procedure
parse arg ggDD
/* ensure file is erased, if no records are written */
call adrTso 'execio' 0 'diskw' ggDD '(open)'
return /* end writeDDBegin */
/*--- write to gg ggDD from stem ggSt, ggCnt records -----------------*/
writeDD:
parse arg ggDD, ggSt, ggCnt
if ggCnt == '' then
ggCnt = value(ggst'0')
call adrTso 'execio' ggCnt 'diskw' ggDD '(stem' ggSt')'
return
endSubroutine writeDD
/*--- end writing to dd ggDD (close) --------------------------------*/
writeDDEnd: procedure
parse arg ggDD
call adrTso 'execio 0 diskw' ggDD '(finis)'
return /* end writeDDEnd */
/*--- send ggTsoCmd to tso, fail if rc <> 0 or not listed in ggRet ---*/
adrTso:
parse arg ggTsoCmd, ggRet
address tso ggTsoCmd
if rc == 0 then return 0
else if ggRet == '*' then return rc
else if wordPos(rc, ggRet) > 0 then return rc
else
call err 'adrTso rc' rc 'for' ggTsoCmd
return /* end adrTso */
/* copy adr end ****************************************************/
/* copy err begin ******************************************************
messages, errorhandling,help
***********************************************************************/
/* caller should define err as follows ---------------------------------
err:
parse arg ggMsg
call errA ggMsg
exit 12
endSubroutine err
end call should define err ----------------------------------------*/
/*--- error routine: abend with message ------------------------------*/
errA:
parse arg ggTxt
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggTxt
x = x / 0
exit setRc(12)
endSubroutine errA
/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure
parse arg ggMsg
say 'fatal error:' ggMsg
call help
call err ggMsg
endProcedure errHelp
/*--- set rc for ispf: -----------------------------------------------*/
if a cmd is run by ispStart, its RC is ignored,
but ISPF passes the value of the shared varible zIspfRc
back as return code
----------------------------------------------------------------------*/
setRc: procedure
parse arg zIspfRc
if sysVar('sysISPF') = 'ACTIVE' then do
say 'exitRc setting zIspfRc='zIspfRc
address ispExec vput 'zIspfRc' shared
end
return zIspfRc
endProcedure setRc
/*--- output a trace message if m.trace is set -----------------------*/
trc: procedure expose m.
parse arg msg
if m.trace == 1 then
say 'trc:' msg
return
endProcedure trc
/*--- quote string txt using quoteChar qu ("""" ==> ") ---------------*/
quote: procedure
parse arg txt, qu
if qu = '' then
qu = '"'
res = qu
ix = 1
do forever
qx = pos(qu, txt, ix)
if qx = 0 then
return res || substr(txt, ix) || qu
res = res || substr(txt, ix, qx-ix) || qu || qu
ix = qx + length(qu)
end
endProcedure quote
/*--- return current time and cpu usage ------------------------------*/
showtime: procedure
parse arg showmsg
return time() sysvar('syscpu') /* sysvar('syssrv') */ showmsg
/--- display the first comment block of the source as help -----------*/
help: procedure
parse source . . s3 .
say 'help for rexx' s3
do lx=1 by 1
if pos('/*', sourceLine(lx)) > 0 then
leave
else if lx > 10 then do
say 'initial commentblock not found for help'
return
end
end
do lx=lx+1 by 1
li = strip(sourceLine(lx), 't', ' ')
if pos('*/', li) > 0 then
leave
say li
end
return 4
endProcedure help
/* copy err end *****************************************************/