zOs/REXX.O13/PVSRWGRV
/* rexx ****************************************************************
pvsRwgrV: Verrechnung Jes Output
synopsis: pvsRwgrV [-opt ...] rz ...
rz 1 oder mehre RZs (RZ1 RZ2 usw)
and -opt may be one of the following options (0 - n allowed)
-T trace
-H, -? this help
-V Verrechnungsfiles erstellen
-Lcla monatlichen/jährlich Loesch/Putzaktion
alte MonatsFiles mit SMS mgmtClass cla erstellen
-Snode,cla send the created monthly save Files to Node node
create them there with mgmtClass cla
-PpFr,pTo add prefix mapping from pFr to pTo (additive)
-P clear all prefix mappings
Funktion -V:
schreibe alle nicht verrechneten JesOut Records
vor dem aktuellen Datum aus dem JesOut Logfiles
auf das File DD VERR für DWS
append ans verrLog einen Logeintrag (fun=verr),
der besagt, bis wohin jetzt für welche RZ verrechet wurde
aus verrLog wird auch bestimmt, was schon verrechnet wurde
Funktion -L:
falls JesOut Logfile Records aus mehr als einem Monat enthält,
schiebe alte Monate in Monatsfiles
Achtung: falls auch -V gesetzt nur das erste rz
falls -V gesetzt und verrLog Einträge aus Vorjahren enthält,
schiebe alte Jahre in Jahresfiles
Option -P:
definieren eine Liste von Prefix Übersetzungen, Default
WGR.RZ1.P0.AKT.LST. ==> WGR.U0034.P0.VERR.LST.RZ1.
WGR.RZ2.P0.AKT.LST. ==> WGR.U0034.P0.VERR.LST.RZ2.
die monatlichen/jährlichen SaveFiles für <pFr><Rest> heissen
<pTo><Rest>yy <pTo><Rest>yymm
<pFr><Rest>yy <pFr><Rest>yymm
je nachdem ob <pFr> ==> <pTo> in der Uebers.Liste ist
und ob der save jährliches oder monatlich ist
Files
DD VERRLOG: logfile der gelieferten verrechnungsFile
wird gelesen um aufsetzpunkt zu finden
und einträge für aktuell gelieferte Files append'd
Achtung: muss mit disp=mod alloziert sein,
damit append funktioniert
DD LOG<rz>: JesOuput Logfile für jedes gewählte RZ
DD VERR: das output File
DD SYSPRT: Meldungen und Trace
Inhalt dd VERR: Ein Record pro output File
(damit Stapel richtig aus Seiten berechnet werden können)
Record Layout (total länge 60 Byte)
pos len typ Inhalt
Feld len offs Inhalt
JOB 8 0 gguuXXXX gg=Gebietspointer
uu=UmsetzungsCode
XXXX=Filler (zurzeit 'XXXX')
MACHINE 4 8 RZ1 oder RZ2
OUCLASS 1 12 Output Class
SMFDATE 9 13 ddMonyyyy PrintDatum, z.B. 04JUL2005
PAGECNT 8 22 Anzahl Seiten, z.B. 00000123
TOLINES 8 30 Anzahl Zeilen, immer 00000000
FORM 8 38 Printer immer '2240'
pvsPrintTst 14 46 yyyymmddHHMMSS Print Timestamp
60
************************************************************************
History
30.08.2005 W. Keller, -p option for prefix translation
30.08.2005 W. Keller, -s option to send monthly files to other node
30.08.2005 W. Keller, monthly/yearly save: create also empty files
29.08.2005 W. Keller, Stapelgroesse = 2000 gemäss Mail Malnati
23.08.2005 W. Keller, yearly cleanup of verrLog
22.08.2005 W. Keller, erlaube leere LogFiles
24.06.2005 W. Keller, neu
***********************************************************************/
parse arg args
/* analyse arguments */
m.trace = 0
rz = ''
verr = 0
lOpt = ''
sNode = ''
sClass = ''
m.prefix.1.from = 'WGR.RZ1.P0.AKT.LST.'
m.prefix.1.to = 'WGR.U0034.P0.VERR.LST.RZ1.'
m.prefix.2.from = 'WGR.RZ2.P0.AKT.LST.'
m.prefix.2.to = 'WGR.U0034.P0.VERR.LST.RZ2.'
m.prefix.0 = 2
do wx=1 to words(args)
w = translate(word(args, wx))
if w='?' | w ='-?' | w= '-H' then
return help()
else if w = '-T' then
m.trace = 1
else if w = '-V' then
verr = 1
else if left(w, 2) = '-L' then
lOpt = substr(w, 3)
else if left(w, 2) = '-S' then
parse var w 3 sNode "," sClass
else if left(w, 2) = '-P' then do
if w = '-P' then do
m.prefix.0 = 0
end
else do
px = m.prefix.0 + 1
m.prefix.0 = px
parse var w 3 m.prefix.px.from "," m.prefix.px.to
end
end
else
rz = rz w
end
dat = date('s')
tim = time('n')
/* test in foreground */
testFree = ''
if rz == '' then do
if sysvar(sysenv) ^== 'FORE' then
call errHelp 'rz not specified'
say 'forground mode ==> test'
sNode = 'RZ2'
sClass = 'S005Y011'
if lOpt = '' & ^ verr then do
verr = 1
lOpt = A008Y000
end
call adrTso "alloc dd(verrLog) mod dsn(lst.vrLog)"
call adrTso "alloc dd(logRZ1) old dsn(lst.log)"
call adrTso "alloc dd(logRZ2) old dsn(lst.rz2.log)"
call adrTso "alloc shr dd(verr) old dsn(lst.verr)"
rz = 'RZ1 RZ2'
testFree = 'verrLog logRZ1 logRZ2 verr'
end
say 'pvsRwgrV analysed: RZs='rz 'verr='verr 'trace=' m.trace
say ' loesch='lOpt 'send='sNode 'cla='sClass
say ' runTimestamp='dat tim
do px=1 to m.prefix.0
say ' prefix' m.prefix.px.from '==>' m.prefix.px.to
end
m.oldFiles = ''
if verr then /* tägliche Verrechnung */
call logVerr 'verrLog', 'verr', dat, tim, rz
if lOpt ^== '' then do /* monthly/yearly cleanup*/
if ^ verr then do
do x=1 to words(rz)
call logCleanupMon lOpt, left(dat, 6), word(rz, x)
end
end
else if logCleanupMon(lOpt, left(dat, 6), word(rz, 1)) then do
call logCleanupYear left(dat, 4), 'verrLog', rz
end
end
if sNode ^== '' then do
if sClass ^== '' then
sClass = mgmtClas sClass
do fx=1 to words(m.oldFiles)
fi = dsnFromJcl(word(m.oldFiles, fx))
call connectDirect fi, sNode, ,disp new, wait yes, sClass
end
end
if testFree ^== '' then
call adrTso 'free dd('testFree')'
say 'pvsRwgrV end' rz dat tim
exit
logVerr: procedure expose m.
parse upper arg ddVerrLog, ddOut, ruDa, ruTi, argRz
/*----------------------------------------------------------------------
schreibe alle nicht verrechneten Records
vor dem Datum ruDa
append ein fun=verr Record ans log, der nachweist,
bis wohin wir verrechnet haben
Parameter
ddLog: dd des Logfile, muss disp=mod alloziert sein,
damit append funktioniert
ddOut: dd für das output Verrechnungs file
ruDa, ruTi: run = liefer Datum und Zeit
argEnv: Ziel Umgebung (TEST oder PROD)
----------------------------------------------------------------------*/
/* search verrLog */
call readDDBegin ddVerrLog
m.vl.first = 999999
cnt = 0
do while readNext(ddVerrLog, vl.)
cnt = cnt + vl.0
do r=1 to vl.0
call trc 'vl.'r vl.r
rz = translate(word(vl.r, 3))
if left(rz, 5) = 'VERR=' then do
rz = substr(rz, 6)
if symbol("rz.rz") ^== "VAR" then do
t1 = getTo(vl.r, rz, 'erste Verrechnung rz' rz)
if t1 << m.vl.first then
m.vl.first = t1
end
rz.rz = vl.r
end
end
end
call readDDEnd ddVerrLog
call trc 'm.vl.first' m.vl.first
say 'read' cnt 'records from dd' ddVerrLog
call writeDDBegin ddOut
logX = 0
m.logOut.0 = 0
/* verrechnung for each rz */
do wx = 1 to words(argRZ)
rz = word(argRZ, wx)
if symbol('rz.rz') ^== 'VAR' then
call err 'rz' rz 'not found in dd' ddVerrLog
call trc 'letzte Verrechnung rz' rz':' rz.rz
tst = getTo(rz.rz, rz, 'letzte Verrechnung rz' rz)
m.logOut.pref = ruDa ruTi 'verr='rz
call logRz 'log'rz, ddOut, rz, word(tst,1) word(tst,2), ruDa
end
call writeDDEnd ddOut
/* append VerrLog Eintraege */
say 'append' m.logOut.0 'Eintraege auf dd' ddVerrLog
call writeDDBegin ddVerrLog
call writeNext ddVerRLog, m.logOut.
call writeDDEnd ddVerrLog
return
endProcedure logVerr
/*----------------------------------------------------------------------
analyse the log reccord passed as first argument
check rz if argument rz not empty
isssue a msg if argument msg not empty
set m.getTo.qRZ to rz
set m.getTo.qTo to toTimestamp
return toTimestamp
----------------------------------------------------------------------*/
getTo: procedure expose m.
parse arg lDat lTim contents, rz, msg
call scanBegin sLW, 's', contents
if ^scanKeyValue(sLW) | m.sLW.key ^== 'VERR' ,
| (rz ^== '' & m.sLW.val ^== rz) then
call scanErr sLw, 'rz' rz 'mismatch'
m.getTo.qRZ = m.sLW.val
if ^scanKeyValue(sLW) | m.sLW.key ^== 'TO' then
call err 'to missing in dd' ddVerrLog':' lDat lTim contents
m.getTo.qTo = strip(m.sLW.val)
if msg ^== '' then
say msg 'to' m.getTo.qTo 'Lieferung' lDat lTim
return m.getTo.qTo
endProcedure getTo
/*----------------------------------------------------------------------
store on verrLog record in stem m.logout.
----------------------------------------------------------------------*/
logOut: procedure expose m.
parse arg msg
x = m.logOut.0 + 1
m.logOut.0 = x
m.logOut.x = m.logOut.pref msg
say 'logOut.' || x m.logOut.x
return
endProcedure logOut
/*----------------------------------------------------------------------
process the log of one RZ
----------------------------------------------------------------------*/
logRZ: procedure expose m.
parse arg ddLog, ddOut, rz, frTst, toTst
say 'verrechnung rz' rz 'from' frTst 'to' toTst ,
'dd' ddLog '==>' ddOut
/* position log */
call readDDBegin ddLog /* at beginning */
rNr = 0
ro = 0
/* skip old records */
found = 0
do while readNext(ddLog, ri.)
if rNr = 0 then
m.log1.rz = ri.1
do r=1 to ri.0
rNr = rNr + 1
cDaTi = word(ri.r ,1) word(ri.r, 2)
if cDaTi << lDaTi then
call err 'dateTime decreasing dd' ddLog rNr ri.r
lDaTi = cDaTi
if lDaTi >> frTst then do
found = 1
call trc 'first after fromTst:' rNr ri.r
leave
end
end
if found then
leave
end
if ^ found then do
say 'alle Records schon verrechnet in' ddLog
call readDDEnd ddLog
m.logE.rz = cDaTi
return ''
end
/* process records */
qStapel = 2000
call logRzDayBegin cDaTi
do while cDaTi << toTst /* each record */
if lDa ^== word(cDaTi, 1) then do
if c.jobs > 0 then
call logRzDayEnd laDaTi /* finish old day */
lDa = word(cDaTi, 1)
call logRzDayBegin cDaTi /* start new day */
end
laDaTi = cDaTi
/* prepare output record */
da = left('', 8),
|| left(rz, 5),
|| right(translate(,
space(DATE('n', word(cDaTi, 1), 's'), 0)), 9, '0'),
|| left('', 16, '0'),
|| left('2240', 8),
|| space(translate(cDaTi, ' ', ':'), 0)
call trc 'da begin' length(da) da
call scanBegin s, 's', substr(ri.r, wordIndex(ri.r, 3))
pages = 0
recs = 0
chars = 0
copies = 1
cla = 5
/* analyse one log record */
do while scanKeyValue(s)
select;
when m.s.key = 'VERRECHNUNG' then
da = overlay(m.s.val, da, 1, 8, 'X')
when m.s.key = 'CLASS' then
cla = m.s.val
when m.s.key = 'COPIES' then
copies = m.s.val
when m.s.key = 'PAGES' then
pages = m.s.val
when m.s.key = 'RECORDS' then
recs = m.s.val
when m.s.key = 'CHARACTERS' then
chars = m.s.val
otherwise nop
end
end
if ^ m.s.eof then
call scanErr s, 'key=value expected'
call scanEnd s, 's' ri.r
/* write verrechnung */
da = overlay(cla, da, 13, 1)
paCo = pages * copies
da = overlay(right(paCo, 8, '0'), da, 23, 8)
c.jobs = c.jobs + 1
call trc 'da end ' length(da) da
ro = ro + 1
ro.ro = da
/* statistics */
if wordPos(cla, c.classes) < 1 then do
c.classes = c.classes cla
c.cla.jo = 0
c.cla.pa = 0
c.cla.re = 0
c.cla.ch = 0
c.cla.st = 0
end
c.cla.jo = c.cla.jo + 1
c.cla.pa = c.cla.pa + paCo
c.cla.re = c.cla.re + recs
c.cla.ch = c.cla.ch + chars
c.cla.st = c.cla.st + ((paCo + qStapel - 1) % qStapel)
/* get next record */
r = r + 1
if r > ri.0 then do
/* read rsp. write next block */
if ^ readNext(ddLog, ri.) then
leave
r = 1
ro.0 = ro
call writeNext ddOut, ro.
ro = 0
end
cDaTi = word(ri.r, 1) word(ri.r, 2)
end /* read ddLog */
/* finish */
m.logE.rz = cDaTi
call readDDEnd ddLog
if c.jobs > 0 then
call logRzDayEnd laDaTi
if ro > 0 then do
ro.0 = ro
call writeNext ddOut, ro.
ro = 0
end
if c.allJobs == 0 then
say 'alle Records schon verrechnet oder zu jung in' ddLog
return
endProcedure logRz
/*----------------------------------------------------------------------
initialise stem c. for a new day
----------------------------------------------------------------------*/
logRzDayBegin: procedure expose c. m.
parse arg cDaTi
if symbol('c.allJobs') == 'VAR' then
aj = c.allJobs
else
aj = 0
drop c.
c.allJobs = aj
c.classes = ''
c.fiDaTi = cDaTi
c.jobs = 0
return
endSubroutine logRzDayBegin
/*----------------------------------------------------------------------
create the verrLog Record for one day from stem c.
----------------------------------------------------------------------*/
logRzDayEnd: procedure expose c. m.
parse arg laDaTi
c.allJobs = c.allJobs + c.jobs
call trc rz':' c.jobs 'from' c.fiDaTi 'to' laDaTi 'total' c.allJobs
/* statistic per class */
names = jo pa st re ch
labels = 'jobs pages stapel records characters'
do nx=1 to words(names)
nm = word(names, nx)
c.nm = 0
end
res = ''
do cx=1 to words(c.classes) /* add statistics for each class */
cla = word(c.classes, cx)
txt = ''
do nx=1 to words(names)
nm = word(names, nx)
txt = txt c.cla.nm
c.nm = c.nm + c.cla.nm
end
call trc 'class' cla txt
res = res 'class'cla'='quote(strip(txt))
end
txt = ''
do nx=1 to words(names)
nm = word(names, nx)
txt = txt word(labels, nx)'='c.nm
end
call trc 'total' txt
call logOut 'to=' || quote(laDati) ,
'from=' || quote(c.fiDaTi) txt res
return
endProcedure logRzDayEnd
logSearchTest: procedure expose m. d.
parse arg ddIn
/*----------------------------------------------------------------------
test logSearch several times
with different read chunks
----------------------------------------------------------------------*/
ro = logSearch(ddIn, '*')
say 'ro' ro
do i=0 to 50
o.i = d.i
end
do cnt=1 by 1 to 20
drop d.
rn = logSearch(ddIn, cnt)
if rn ^== ro then
call err 'check cnt' cnt 'rn' rn '^== ro' ro
do i=0 to 50
if d.i ^== o.i then
call err 'check cnt' cnt 'd.'i d.i '^== o.'i o.i
end
call readDDBegin ddIN
rr = word(rn, 3)
if rr > 0 then do
call adrTso 'execio' (rr-1) 'diskr' ddIn '(skip stem q.)'
call readNext ddIn, q., 1
if q.1 ^== substr(rn, wordIndex(rn, 4)) then
call err 'restart err rec' rr q.1 '^==' rn
end
call readDDEnd ddIN
end
return ro
endProcedure logSearchTest
/*----------------------------------------------------------------------
move Reocrds aus Vormonaten in Monatsfile
----------------------------------------------------------------------*/
logCleanupMon: procedure expose m.
parse arg pClas, nextMon, rz
ddLog = 'log'rz
if right(nextMon, 2) >> '01' then
oldMon = nextMon - 1
else
oldMon = nextMon - 89
call trc 'logCleanupMon next' nextMon 'old' oldMon 'rz' rz ,
'dd' ddLog
if 0 ^== listDsi(ddLog 'file') then
call err 'listDsi('ddLog 'file)' sysmsglvl2
logName = sysDsName
oldPref = prefixChange(logName)
atts = "mgmtClas("pClas") like('"logName"')"
oldName = "'"oldPref || right(oldMon, 4)"'"
oldSys = sysDsn(oldName)
call trc 'oldName' oldName oldSys
if oldSys == 'OK' then do
if symbol('m.log1.rz') == 'VAR' then
if nextMon >> left(word(m.log1.rz ,1), 6) then
call err oldName 'exists but' logName ,
'contains old entry' m.log1.rz
say 'monthly cleanup already done for' ddLog logName
say ' to file' oldName
return 0
end
say 'monthly cleanup before' nextMon 'of' ddLog logName
lMo = ''
lFi = ''
cIn = 0
/* read ddLog */
call adrTso "alloc dd(logOld) old dsn('"logName"')"
call readDDBegin logOld
do while readNext(logOld, ri.)
rMax = ri.0
cIn = cIn + rMax
r = 0
do while r < rMax
r = r + 1
cMo = left(word(ri.r, 1), 6)
if cMo == lMo then
iterate
else if cMo << lMo then
call err "month decreses in file" logName "from" lMo,
"to" cMo "in" ri.r
/* Monatswechsel */
cFi = right(cMo, 4)
lMo = cMo
if cMo >>= nextMon then do
cFi = 'save'
if lFi == '' then do
say 'dd' ddLog 'enthaelt nur Recs >= Monat' nextMon
call readDDEnd logOld
call adrTso "free dd(logOld)"
/* write empty file */
cFi = right(oldMon, 4)
m.oldFiles = m.oldFiles oldPref || cFi
call writeEmpty ddMon, "'"oldPref || cFi"'", atts
return 1
end
end
if cFi == lFi then
iterate
if cFi ^== 'save' then
m.oldFiles = m.oldFiles oldPref || cFi
if lFi ^== '' then do
/* letzten Monat schreiben */
ri.0 = r-1
cOut = cOut + ri.0
call writeNext ddMon, ri.
call writeDDEnd ddMon
call adrTso 'free dd(ddMon)'
say cOut 'records written to' oldPref || lFI
/* neuen Monat nach vorne schieben */
t = 0
do r=r to rMax
t = t+1
ri.t = ri.r
end
rMax = t
r = 1
end
lFi = cFi
/* neues File erstellen */
cOut = 0
call allocNew ddMon, "'"oldPref || cFi"'", atts
end
if lFi ^== '' then do
/* nächsten Block schreiben */
ri.0 = rMax
cOut = cOut + rMax
call writeNext ddMon, ri.
end
end
if lFi ^== '' then do
call writeDDEnd ddMon
if lFi ^== 'save' then
call adrTso "free dd(ddMon)"
say cOut 'records written to' oldPref || lFI
end
call readDDEnd logOld
say cIn 'records read from' ddLog logName
if lFi == '' then do
/* write empty file */
cFi = right(oldMon, 4)
m.oldFiles = m.oldFiles oldPref || cFi
call writeEmpty ddMon, "'"oldPref || cFi"'", atts
return 1
end
/* save auf log überklatschen */
cIn = 0
call writeDDBegin logOld
if lFi == 'save' then do
call readDDBegin ddMon
do while readNext(ddMon, ri.)
cIn = cIn + ri.0
call writeNext logOld, ri.
end
call readDDEnd ddMon
say cIn 'records read from' oldPref || lFI
end
call writeDDEnd logOld
say cIn 'records written to' logName
call adrTso 'free dd(logOld)'
if lFi == 'save' then
call adrTso 'free dd(ddMon) delete'
return 1
endProcedure logCleanupMon
allocNew:procedure expose m.
parse arg dd, dsn, atts
call adrTso "alloc dd("dd") new catalog dsn("dsn")" atts
call writeDDBegin dd
return
endProcedure allocNew
writeEmpty: procedure expose m.
parse arg dd, dsn, atts
call allocNew dd, dsn, atts
call writeDDEnd dd
call adrTso "free dd("dd")"
say "written empty file" dsn
return
endProcedure writeEmpty
prefixChange: procedure expose m.
parse arg old
do px=1 to m.prefix.0
if abbrev(old, m.prefix.px.from) then
return m.prefix.px.to ,
|| substr(old, 1 + length(m.prefix.px.from))
end
return old
endProcedure prefixChange
/*----------------------------------------------------------------------
move Reocrds aus VorJahr in Jahresfile
----------------------------------------------------------------------*/
logCleanupYear: procedure expose m.
parse arg nextYear, ddLog, allRz
say 'logCleanup nextYear' nextYear 'verrLog' ddLog 'rz' allRz
if 0 ^== listDsi(ddLog 'file smsinfo') then
call err 'listDsi('ddLog 'file)' sysmsglvl2
logName = sysDsName
atts = "mgmtClas("sysMgmtClass") like('"logName"')"
say 'dd' ddlog 'atts' atts
oldPref = prefixChange(logName)
oldName = "'"oldPref || right(nextYear -1, 2)"'"
oldSys = sysDsn(oldName)
call trc 'oldName' oldName oldSys 'first' m.vl.first
if oldSys == 'OK' then do
if symbol('m.vl.first') == 'VAR' then
if nextYear >> m.vl.first then
call err oldName 'exists but' logName ,
'contains old entry to' m.vl.first
say 'yearly cleanup already done for' ddLog logName
say ' to file' oldName
return 0
end
say 'yearly cleanup before' nextYear 'for' ddLog logName
rz.nextYear = ''
yys = ''
call adrTso "alloc dd(ddOld) old dsn('"logName"')"
call readDDBegin ddOld
oc = 0
do while readNext(ddOld, o., 3)
oc = oc + o.0
do rx=1 to o.0
y = left(getTo(o.rx), 4)
if wordPos(y, yys) < 1 then do
if verify(y, '0123456789') ^== 0 | y >> nextYear then
call err "bad to year '"y"' in" o.rx
yys = yys y
call allocNew "dd"y, "'"oldPref || right(y, 2)"'", atts
say 'new year' y
w.y.0 = 0
w.y.aa = 0
rz.y = ''
end
wx = w.y.0 + 1
w.y.0 = wx
w.y.wx = o.rx
if wordPos(m.getto.qRZ, rz.y) < 1 then
rz.y = rz.y m.getTo.qRZ
end
call writeW 4
end
call readDDEnd ddOld
say oc 'records read from ddOld' logName
call writeW 1
do i=1 to words(yys)
y = word(yys, i)
call writeDDend 'dd'y
call adrTso 'free dd(dd'y')'
say w.y.aa 'records written to dd'y 'for' rz.y
end
if wordPos((nextYear -1), yys) < 1 then
call writeEmpty ddEmpty, oldName, atts
call writeDDBegin ddOld
if wordPos(nextYear, yys) > 0 then do
call adrTso "alloc dd(ddTmp) old",
"dsn('"oldPref || right(nextYear, 2)"')"
call readDDBegin ddTmp
cn = 0
do while readNext(ddTmp, n.)
cn = cn + n.0
call writeNext ddOld, n.
end
call readDDEnd ddTmp
say cn "records copied from" oldPref || nextYear "to" logName
end
else do
say cn "no records for year" nextYear "in" logName
end
logPr = subword(m.logOut.pref, 1, 2)
y = nextYear
nx = 0
do i=1 to words(allRz)
rz = word(allRz, i)
if wordPos(rz, rz.y) > 0 then do
say 'rz' rz 'already in' logName
end
else do
nx = nx + 1
n.nx = logPr 'verr='rz 'to='nextYear'0101 00:00:00'
say 'adding rz' rz 'to' logName':' n.nx
end
end
if nx > 0 then do
n.0 = nx
call writeNext ddOld, n., nx
say nx 'records appended to' logName
end
call writeDDEnd ddOld
call adrTso "free dd(ddOld)"
if wordPos(nextYear, yys) > 0 then
call adrTso "free dd(ddTmp) delete"
return
endProcedure logCleanupYear
/*----------------------------------------------------------------------
write blocks to each yearFile with a minimum of min records
----------------------------------------------------------------------*/
writeW:
parse arg min
do i=1 to words(yys)
y = word(yys, i)
if w.y.0 >= min then do
call writeNext 'dd'y, w.y.
w.y.aa = w.y.aa + w.y.0
w.y.0 = 0
end
end
return
endProcedure writeW
trc: procedure expose m.
parse arg msg
if m.trace = 1 then
say 'trc: ' msg
return
endProcedure trc
err:
parse arg ggMsg
call errA ggMsg
exit 12;
connectDirect: procedure
/*******************************************************************
send the file frDsn from the current not
to the node toNode as toDsn if not empty
using connect direct
additional connect direct attributes may be specified
by arguments 4... (with ,a b, or equifalently , a='b',
********************************************************************/
parse upper arg frDsn, toNode, toDsn
say 'sending' frDsn 'to' toNode toDsn 'with connect direct'
call adrTso "alloc shr dd(sysut1) reuse dsn("frDsn")"
call adrTso "alloc new delete dd(DDIN) dsn("dsnTemp(connDir)")" ,
"recfm(f,b) lrecl(80)"
call writeDDBegin ddIn
t.1 = "DEST='"toNode"'"
t.2 = "DSNCOPY='YES'"
x=2
if toDsn ^= '' then do
x = x + 1
t.x = "DSN='"dsn2Jcl(toDsn)"'"
end
do ax=4 to arg()
parse upper value arg(ax) with key val
val = strip(val)
call trc 'arg' ax':' arg(ax) 'key' key "val '"val"'"
if key = '' then
iterate
x = x+1
if pos("=", key) > 0 then
t.x = key val
else
t.x = key"='"val"'"
end
call writeNext ddIn, t., x
call writeDDEnd ddIn
if 1 then do
call trc 'connectDirect ddIn' x
do i=1 to x
call trc i t.i
end
end
call adrTso "call *(OS2900)"
call adrTsoRc 'free dd(sysut1)' /* a ghost freed it already */
call adrTso 'free dd(ddin) delete'
/* os2900 does not free it dd's, so we do it
otherwise the second run will fail... */
call adrTsoRc 'free dd(ddPrint work01 cmdout dmprint)'
say 'end connectDirect'
return /* end connectDirect */
/* copy scan begin ****************************************************/
/**********************************************************************
Scan: scan an input:
scanBegin(m,..): set scan Source to a string, a stem or a dd
scanEnd (m) : end scan
scanBack(m) : 1 step backwards (only once)
scanChar(m,n) : scan next (nonSpace) n characters
scanName(m,al) : scan a name if al='' otherwise characters in al
scanNum(m) : scan integer (without sign)
scanString(m,q): scan a String with quote q. (with doubble = 1)
scanErr(m, txt): error with current scan location
***********************************************************************/
scanTest: procedure
m.q.1 = " 034uUnd hier123sdfER'string1' 'string2''mit''apo''s' "
m.q.2 = " "
m.q.3 = "'erstn''s' = ('ers' || 'tn' || '''s')"
m.q.4 = " drei;+HHhier123sdfER?? '''' "
m.q.0 = 4
say 'scanTest begin' m.q.0 'input Lines'
do i=1 to m.q.0
say 'm.q.'i m.q.i
end
call scanBegin s, 'm', q
do forever
if scanName(s) then
say 'scanned name' m.s.tok
else if scanNum(s) then
say 'scanned num' m.s.tok
else if scanString(s) then
say 'scanned string val' length(m.s.val)':' m.s.val ,
'tok' m.s.tok
else if scanChar(s,1) then
say 'scanned char' m.s.tok
else
leave
end
call scanEnd s
say 'scanTest end'
return
endProcedure scanTest
scanBegin: procedure expose m.
parse arg m, pTyp, pOpt
m.m.typ = pTyp
if pTyp = 'm' then do
m.m.lines = pOpt
end
else if pTyp = 's' then do
m.m.lines = m
m.m.0 = 1
m.m.1 = pOpt
end
else if pTyp = 'dd' then do
m.m.lines = m
m.m.0 = 0
m.m.dd = pOpt
call readDDBegin m.m.dd
end
else
call err 'bad scanBegin typ' pTyp
m.m.lx = 1
m.m.baseLx = 0
m.m.bx = 1
m.m.cx = 1
m.m.curLi = m.m.lines'.1'
m.m.eof = 0
if pTyp = 'dd' then
call scanNextLine m
return
endProcedure scanBegin
scanEnd: procedure expose m.
parse arg m
if m.m.typ = 'dd' then
call readDDEnd m.m.dd
return
endProcedure scanEnd
scanNextLine: procedure expose m.
parse arg m
l = m.m.lines
m.m.lx = m.m.lx + 1
if m.m.lx > m.l.0 then do
if m.m.typ <> 'dd' then do
m.m.eof = 1
return 0
end
m.m.baseLx = m.m.baseLx + m.m.0
if ^ readNext(m.m.dd, 'm.'m'.') then do
m.m.eof = 1
return 0
end
m.m.lx = 1
end
m.m.curLi = l'.'m.m.lx
m.m.cx = 1
m.m.bx = 1
return 1
endProcedure scanNextLine
scanRight: procedure expose m.
parse arg m, len
l = m.m.curLi
if len <> '' then
if length(m.l) >= m.m.cx + len then
return substr(m.l, m.m.cx, len)
return substr(m.l, m.m.cx)
endProcedure scanRight
scanLeft: procedure expose m.
parse arg m, len
l = m.m.curLi
if len <> '' then
if len < m.m.bx then
return substr(m.l, m.m.bx - len, len)
return left(m.l, m.m.bx - 1)
endProcedure scanLeft
scanChar: procedure expose m.
parse arg m, len
do forever
l = m.m.curLi
vx = verify(m.l, ' ', 'n', m.m.cx)
if vx > 0 then
leave
if ^ scanNextLine(m) then do
m.m.tok = ''
return 0
end
end
if length(m.l) >= vx + len then
m.m.tok = substr(m.l, vx, len)
else
m.m.tok = substr(m.l, vx)
m.m.bx = vx
m.m.cx = vx + length(m.m.tok)
return 1
endProcedure scanChar
scanBack: procedure expose m.
parse arg m
if m.m.bx >= m.m.cx then
call scanErr m, 'scanBack works only once'
m.m.cx = m.m.bx
return 1
endProcedure scanBack
scanString: procedure expose m.
parse arg m, qu
m.m.tok = ''
m.m.val = ''
if qu = '' then
qu = "'"
if ^ scanChar(m, 1) then
return 0
qx = m.m.cx
m.m.cx = m.m.bx
if m.m.tok <> qu then
return 0
l = m.m.curLi
do forever
px = pos(qu, m.l, qx)
if px < 1 then
call scanErr m, 'ending Apostroph('qu') missing'
m.m.val = m.m.val || substr(m.l, qx, px-qx)
if px >= length(m.l) then
leave
else if substr(m.l, px+1, 1) <> qu then
leave
qx = px+2
m.m.val = m.m.val || qu
end
m.m.tok = substr(m.l, m.m.bx, px+1-m.m.bx)
m.m.cx = px+1
return 1
endProcedure scanString
scanName: procedure expose m.
parse arg m, alpha
m.m.tok = ''
if ^ scanChar(m, 1) then
return 0
m.m.cx = m.m.bx
if alpha = '' then do
alpha ,
= '0123456789abcdefghijklmnopqurstuvwxyzABCDEFGHIJKLMNOPQURSTUVWXYZ'
if pos(m.m.tok, alpha) <= 10 then
return 0
end
l = m.m.curLi
vx = verify(m.l, alpha, 'n', m.m.bx)
if vx = m.m.bx then
return 0
if vx < 1 then
m.m.tok = substr(m.l, m.m.bx)
else
m.m.tok = substr(m.l, m.m.bx, vx-m.m.bx)
m.m.cx = m.m.bx + length(m.m.tok)
return 1
endProcedure scanName
scanUntil: procedure expose m.
parse arg m, alpha
m.m.bx = m.m.cx
l = m.m.curLi
m.m.cx = verify(m.l, alpha, 'm', m.m.bx)
if m.m.cx = 0 then
m.m.cx = length(m.l) + 1
m.m.tok = substr(m.l, m.m.bx, m.m.cx - m.m.bx)
return 1
endProcedure scanUntil
scanNum: procedure expose m.
parse arg m
if ^ scanName(m, '0123456789') then
return 0
else if datatype(scanRight(m, 1), 'A') then
call scanErrBack m, 'illegal number'
return 1
endProcedure scanNum
scanKeyValue: procedure expose m.
parse arg m
if ^scanName(m) then
return 0
m.m.key = translate(m.m.tok)
if ^scanChar(m, 1) | m.m.tok <> '=' then
call scanErr m, 'assignment operator (=) expected'
if scanName(m) then
m.m.val = translate(m.m.tok)
else if scanNum(m) then do
m.m.val = m.m.tok
end
else if scanString(m) then
nop
else
call scanErr m, "value (name or string '...') expected"
return 1
endProcedure scanKeyValue
scanErr: procedure expose m.
parse arg m, txt
say 'scanErr' txt
l = m.m.curLi
say 'charPos' m.m.cx substr(m.l, m.m.cx)
whe = 'typ' m.m.typ
if m.m.typ = 'dd' then
whe = whe m.m.dd (m.m.baseLx + m.m.lx)
say whe 'line' l m.l
call err 'scanErr' txt
endProcedure scanErr
scanErrBack: procedure expose m.
parse arg m, txt
m.m.cx = m.m.bx /* avoid error by using errBack| */
call scanErr m, txt
endProcedure scanErrBack
/* copy scan end ****************************************************/
/* copy adr begin ****************************************************/
/**********************************************************************
dsn*: manipulate dataSetNames
dsn2Jcl: convert from tso to JCL format
dsnFromJcl: convert from jcl to TSO format
dsnPosLev: get the index of first char of level
(negativ levels are counted from the right)
dsnGetMbr: get the Member name from a dsn
dsnApp: cleanup and append dsn parts (preserve apos ...)
dsnSetMbr: set a Member name or remove it if mbr = ''
dsnTemp return the name of a temporary dataset
dsnGetLLQ ==> dsnGetLev(..., -1) depreciated
***********************************************************************/
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
dsnFromJcl: procedure
parse arg dsn .
return "'"dsn"'"
endProcedure dsnFromJcl
dsnApp: procedure
parse arg parts
dsn = ''
do wx=1 by 1
w = word(parts, wx)
if w = '' then
leave
do while w <> ''
if pos(right(w, 1), "') ") <= 0 then
leave
w = left(w, length(w)-1)
end
dsn = dsn || w
end
if pos('(', dsn) > 0 then
dsn = dsn')'
if left(dsn,1) = "'" then
return "'"strip(dsn, 'b', "'")"'"
else
return dsn
endProcedure dsnApp
dsnSetMbr: procedure
parse arg dsn, mbr
mbr = strip(mbr)
bx = pos('(', dsn)
if mbr = '' then do
if bx < 1 then
return dsn
else if left(dsn, 1) = "'" then
return left(dsn,bx-1)"'"
else
return left(dsn,bx-1)
end
else do
if bx < 1 then
return dsnApp(dsn '('mbr)
else
return dsnApp(left(dsn, bx) mbr)
end
endProcedure dsnSetMbr
dsnGetMbr: procedure
parse arg dsn
lx = pos('(', dsn)
rx = pos(')', dsn, lx+1)
if lx < 1 then
return ''
else if lx < rx then
return substr(dsn, lx+1, rx-lx-1)
else
return strip(substr(dsn,lx+1), 't', "'")
endProcedure dsnGetMbr
dsnPosLev: procedure
parse arg dsn, lx
if lx > 0 then do
if lx = 1 then do
sx = 1
end
else do
sx = posCnt('.', dsn, lx-1) + 1
if sx <= 1 then
return 0
end;
end
else if lx < 0 then do
if lx = -1 then do
ex = 1 + length(dsn)
end
else do
ex = posCnt('.', dsn, lx+1)
if ex < 1 then
return 0
end;
sx = lastPos('.', dsn, ex-1) + 1
end
else
return 0
if sx > 1 then
return sx
else if left(dsn, 1) = "'" then
return 2
else
return 1
endProcedure dsnPosLev
dsnGetLev: procedure
parse arg dsn, lx
sx = dsnPosLev(dsn, lx)
if sx < 1 then
return ''
ex = pos('.', dsn, sx)
if ex < 1 then do
ex = pos('(', dsn, sx)
if ex < 1 then
return substr(dsn, sx)
end
return substr(dsn, sx, ex-sx)
endProcedure dsnGetLev
dsnTemp: procedure
parse upper arg suf
d = 'tmpFile.'mvsVar('SYMDEF', 'JOBNAME')'.'suf
call trc 'tempFile' sub '=>' d
return d
endProcedure dsnTemp
/**********************************************************************
StringHandling
posCnt: return the index of cnt'th occurrence of needle
negativ cnt are counted from the right
***********************************************************************/
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
posCnt: procedure
parse arg needle, hayStack, cnt, start
if cnt > 0 then do
if start = '' then
start = 1
do cc = 1 to cnt
sx = pos(needle, hayStack, start)
if sx < 1 then
return 0
start = sx + length(needle)
end
return start - length(needle)
end
else if cnt < 0 then do
if start = '' then
start = length(hayStack)
do cc = 1 to -cnt
sx = lastPos(needle, hayStack, start)
if sx < 1 then
return 0
start = sx - length(needle)
end
return start + length(needle)
end
else
return 0
endProcedure posCnt
/**********************************************************************
lmd: catalog read
call sequence: lmdBegin, lmdNext*, lmdEnd
mit lmd service (mit save in file und read,
weil list zu langsam und listcat abstürzt)
1. arg (grp) als group dataset für lmd save
und dd name für file read
***********************************************************************/
lmdTest: procedure
parse arg lev
say showTime() 'lmdTest' lev
call lmdBegin 'test', lev
say showTime() 'lmdTest after begin' lev
z = 0
do while lmdNext('test', st.)
do y=1 to st.0
z=z+1
say z word(st.y, 1)
end
end
call lmdEnd 'test'
say showTime() 'lmdTest' z 'files in' lev
return /* readTest */
lmdBegin: procedure
parse arg grp, lev
call adrIsp 'lmdinit listid(lmdId) level('lev')'
call adrIsp 'lmdlist listid(&lmdId) option(save) group('grp')'
call adrIsp 'lmdfree listid(&lmdId)'
say showTime() 'lmdlist save' grp lev
call readBegin grp, grp'.datasets'
return /* end lmdBegin */
lmdNext:
parse arg ggGrp, ggSt
return readNext(ggGrp, ggSt)
lmdEnd: procedure
parse arg grp
call readEnd grp
return /* end lmdEnd */
/**********************************************************************
member list of a pds:
call sequence x=lmmBegin(dsn) lmmNext(x) * lmmEnd(x)
***********************************************************************/
lmmTest: procedure
parse arg dsn
if dsn = '' then
dsn = 'wk.pli(*)'
say 'lmmTest for dsn' dsn
id = lmmBegin(dsn)
do ix=1 by 1
m = lmmNext(id)
if m = '' then
leave
say ix m
end
call lmmEnd id
say 'lmmTest end' (ix-1) 'members in' dsn
return
endProcedure lmmTest
lmmBegin: procedure
parse arg dsn
mbr = dsnGetMbr(dsn)
pds = dsnSetMbr(dsn, )
call adrIsp "LMINIT DATAID(lmmId) DATASET("pds") ENQ(SHRW)"
call adrIsp "LMOPEN DATAID("lmmId") OPTION(INPUT) "
res = lmmId
if mbr <> '' then
res = res 'pattern('mbr')'
say 'lmmBegin returning' res
return res
endProcedure lmmBegin
lmmEnd: procedure
parse arg lmmId opt
if adrIspRc("LMMLIST DATAID("lmmId") option(free)") <> 0 then
if rc <> 8 then
call err "lmmEnd" id lmmId "rc" rc "for lmmList free"
call adrIsp "LMCLOSE DATAID("lmmId")"
call adrIsp "LMFREE DATAID("lmmId")"
return
endProcedure lmmEnd
lmmNext: procedure
parse arg lmmId opt
gmRc = adrIspRc("LMMLIST DATAID("lmmid")" ,
"OPTION(LIST) MEMBER(Mbr)" opt)
if gmRc = 0 then
return mbr
else if gmRc = 8 | gmRC = 4 then
return ''
else
call err 'lmmList rc' gmRc
endProcedure lmmNext
/**********************************************************************
read: read a file
valid call sequences:
readDsn read a whole dsn
readDDBegin, readNext*, readDDEnd read dd in chunks
readBegin, readNext*, readEnd read dsn in chunks
writeBegin, writeNext*, writeEnd write dsn in chunks
readNext liest 100 records in übergebenen stem,
returns false at eof
***********************************************************************/
readTest: procedure
parse arg dsn
say showTime() 'readTest' dsn
call readBegin 'ddEins', dsn
z = 0
do while readNext('ddEins', st.)
do y=1 to st.0
z=z+1
say z strip(st.y, 't')
end
end
call readEnd 'ddEins'
say showTime() 'readTest' z 'records in' dsn
return /* readTest */
readDsn:
parse arg ggDsn, ggSt
call adrTso 'alloc dd(readDsn) shr dsn('ggdsn')'
call adrTso 'execio * diskr readDsn (stem' ggSt' finis)'
call adrTso 'free dd(readDsn)'
return
endSubroutine readDsn
readDDBegin: procedure
return /* end readDDBegin */
readBegin: procedure
parse arg dd, dsn
call adrTso 'alloc dd('dd') shr dsn('dsn')'
return /* end readBegin */
readNext:
parse arg ggDD, ggSt, ggCnt
if ggCnt = '' then
ggCnt = 100
if adrTsoRc('execio' ggCnt 'diskr' ggDD '(stem' ggSt')') = 0 then
return (value(ggSt'0') > 0)
else if rc = 2 then
return (value(ggSt'0') > 0)
else
call err 'execio' ggCnt 'diskr' ggDD 'rc' rc
return /* end readNext */
readDDEnd: procedure
parse arg dd
call adrTso 'execio 0 diskr' dd '(finis)'
return /* end readDDEnd */
readEnd: procedure
parse arg dd
call readDDEnd dd
call adrTso 'free dd('dd')'
return /* end readEnd */
writeDDBegin: procedure
parse arg dd /* explicit open, for (old) empty file */
call adrTso "execio 0 diskw" dd "(open)"
return /* end writeDDBegin */
writeNext:
parse arg ggDD, ggSt, ggLines
if ggLines == '' then
ggLines = value(ggst'0')
call adrTso 'execio' ggLines 'diskw' ggDD '(stem' ggSt')'
return
endSubroutine writeNext
writeDDEnd: procedure
parse arg dd
call adrTso 'execio 0 diskw' dd '(finis)'
return /* end writeDDEnd */
writeDsn:
parse arg ggDsn, ggSt
call adrTso 'alloc dd(ggWrite) dsn('ggDsn')'
call writeDDBegin 'ggWrite'
call writeNext 'ggWrite', ggSt
call writeDDEnd 'ggWrite'
call adrTso 'free dd(ggWrite)'
return
endProcedure writeDsn
/**********************************************************************
writeApp: append lines to a file
ggDsn: dsn to append lines
ggStem stem containing line (with dot|)
ggNr number of lines, if empty <stem>.0
***********************************************************************/
writeApp:
parse arg ggDsn, ggStem, ggNr
if ggNr = '' then
ggNr = value(ggStem'0')
if pos('(', ggDsn) < 1 then do /* sequential ds, use disp=mod */
call adrTso 'alloc mod reuse dd(ddApp) dsn('ggDsn')'
end
else do /* pds: read and rewrite */
call adrTso 'alloc shr reuse dd(ddApp) dsn('ggDsn')'
if sysdsn(ggDsn) = 'OK' then do
call adrTso 'execio * diskr ddApp (stem ggL. finis)'
call adrTso 'execio' ggL.0 'diskw ddApp (stem ggL.)'
end
end
call adrTso 'execio' ggNr 'diskw ddApp (stem' ggStem 'finis)'
call adrTso 'free dd(ddApp)'
return
endProcedure writeApp
log: procedure
parse arg logLine
l.1 = date('s') time() logLine
call writeApp 'wk.out(ll)', l., 1
return
endProcedure log
/**********************************************************************
adrSql: execute sql thru the dsnRexx interface
***********************************************************************/
adrSqlRc: /* no procedure, to keep variables sql... */
parse arg ggSqlStmt, ggNo
if ggNo <> '1' then
ggSqlStmt = 'execSql' ggSqlStmt
address dsnRexx ggSqlStmt
if rc = 0 then
return 0 /* say "sql ok:" ggSqlStmt */
else if rc < 0 then
call err "sql rc" rc sqlmsg()
if sqlCode = 0 then
say 'warning' sqlMsg()
return sqlCode
endSubroutine adrSqlRc
adrSql: /* no procedure, to keep variables sql... */
parse arg ggSqlStmt, ggNo
if adrSqlRc(ggSqlStmt, ggNo) = 0 then
return
call err "sql rc" rc sqlmsg()
endSubroutine adrSql
adrSqlConnect: procedure
parse arg sys
if adrTSORc("SUBCOM DSNREXX") <> 0 then do
sRc = RXSUBCOM('ADD','DSNREXX','DSNREXX') /* ADD HOST CMD ENV */
if sRc <> 0 then
call err 'rc' sRc 'from RXSUBCOM(ADD, DSNREXX, DSNREXX)'
end
call adrSql "connect" sys, 1
return
endProcedure adrSqlConnect
adrSqlDisconnect: procedure
call adrSql "disconnect ", 1
return
endProcedure adrSqlDisconnect
sqlMsg: /* no procedure, to keep variables sql... */
ggW = ''
do ggX=0 to 10
if sqlWarn.ggx <> '' then
ggw = ggw ggx'='sqlWarn.ggx
end
return 'sqlCode' sqlCode 'state' sqlState 'warn' ggW ,
'errMc' strip(translate(sqlerrmc, ',', 'FF'x))':' ggSqlStmt
endSubroutine sqlMsg
/**********************************************************************
adrDsn: send a command to db2 with the TSO dsn command
***********************************************************************/
adrDsn: procedure
parse arg sys, cmd, rcOk
call adrTso 'alloc dd(sysprint) new reuse'
push 'END'
push cmd
rr = adrTsoRc('DSN SYSTEM('sys')')
say 'rc' rr 'adrTso DSN SYSTEM('sys') cmd' cmd
if wordPos(rr, rcOk) < 1 then do
say 'error rc' rr 'in adrTso DSN SYSTEM('sys') cmd' cmd
call adrTso 'execio * diskr sysprint (finis stem pr.)'
say 'sysprint' pr.0 'lines'
do x=1 to pr.0
say strip(pr.x, 't')
end
call adrTso 'free dd(sysprint) '
call err 'rc' rr 'in adrTso DSN SYSTEM('sys') cmd' cmd
end
call adrTso 'free dd(sysprint)'
return rr
endProcedure adr Dsn
/**********************************************************************
adr*: address an environment
adrTso: fails if rc <> 0
adrTsoRc: returns rc without failing
***********************************************************************/
adrTsoRc:
parse arg tsoCmd
address tso tsoCmd
return rc /* end adrTsoRc */
adrTso:
parse arg tsoCmd
address tso tsoCmd
if rc <> 0 then
call err 'adrTso rc' rc 'for' tsoCmd
return /* end adrTso */
adrIspRc:
parse arg ispCmd
address ispexec ispCmd
return rc /* end adrIspRc */
adrIsp:
parse arg ispCmd
address ispexec ispCmd
if rc <> 0 then
call err 'adrIsp rc' rc 'for' ispCmd
return /* end adrIsp */
adrEdit:
parse arg editCmd, ret
address isrEdit editCmd
if rc <> 0 then
call err 'adr isrEdit rc' rc 'for' editCmd
return /* end adrEdit */
adrEditRc:
parse arg editCmd
address isrEdit editCmd
return rc /* end adrEditRc */
/**********************************************************************
messages, errorhandling help
***********************************************************************/
errA:
/* caller should define err as follows:
err: parse arg ggMsg; call errA ggMsg; exit 12; */
parse arg ggTxt
parse source . . ggS3 .
say 'fatal error in' ggS3':' ggTxt
exit setRc(12)
endSubroutine err
setRc: procedure
parse arg zIspfRc
/**********************************************************************
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
***********************************************************************/
if sysVar('sysISPF') = 'ACTIVE' then do
say 'exitRc setting zIspfRc='zIspfRc
address ispExec vput 'zIspfRc' shared
end
return zIspfRc
endProcedure setRc
errHelp: procedure
parse arg ggMsg
say 'fatal error:' ggMsg
call help
call err ggMsg
endProcedure errHelp
help: procedure
/**********************************************************************
display the first comment block of the source as help text
***********************************************************************/
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
showtime: procedure
parse arg showmsg
return time() sysvar('syscpu') sysvar('syssrv') showmsg
/* copy adr end ****************************************************/