zOs/REXX.O08/TT
/*********************************************************************/
/* */
/* INITIALIZE WORK VARIABLES */
/* */
/*********************************************************************/
RESUME = 'Y' /* SET RESUME FLAG */
CSIDSN.0 = 0 /* A COUNT OF DSNAMES FILLED */
/*********************************************************************/
/* */
/* SET UP LOOP FOR RESUME (IF A RESUME IS NECESSARY) */
/* */
/*********************************************************************/
DO WHILE RESUME = 'Y' /* UNTIL EOF OF CATALOG READ */
ADDRESS LINKPGM 'IGGCSI00 m.'m'.reason m.'m'.filt m.'m'.work'
/* GET RESUME FLAG FOR NEXT LOOP */
RESUME = SUBSTR(m.m.filt,150,1)
USEDLEN = C2D(SUBSTR(m.m.work,9,4)) /* GET AMOUNT OF WORK AREA USED */
POS1=15 /* STARTING POSITION */
/********************************************************************/
/* */
/* PROCESS DATA RETURNED IN WORK AREA */
/* */
/********************************************************************/
DO WHILE POS1 < USEDLEN /* UNTIL ALL DATA IS PROCESSED */
IF SUBSTR(m.m.work,POS1+1,1) = '0' THEN /* IF ITS THE CATALOG */
DO
POS1 = POS1 + 50 /* SKIP TO THE END OF IT */
END
ELSE DO /* IF NOT CATALOG */
IF SUBSTR(m.m.work,POS1+1,1) = 'A' THEN /* ONLY PROCESS NVSAM */
DO
CSIDSN.0 = CSIDSN.0 + 1 /* COUNT DSNAMES FILLED */
DSN = SUBSTR(m.m.work,POS1+2,44) /* GET THE DSNAME */
if dsn <> dsnMask then
call err 'dsn' dsn '<> dsnMask' dsnMask
pL = POS1 + 50
L1 = c2d(SUBSTR(m.m.work,PL, 2))
L2 = c2d(SUBSTR(m.m.work,PL+2, 2))
L3 = c2d(SUBSTR(m.m.work,PL+4, 2))
dt = substr(m.m.work, pL+6, l1)
vo = substr(m.m.work, pL+6+l1, l2)
cl = substr(m.m.work, pL+6+l1+l2, l3)
cl = substr(cl, 3, c2d(left(cl, 2)))
if vo = '' then
say err '||| no volume for dsn' dsn
else if vo = 'ARCIVE' then
res = 'arcive'
else if cl <> '' then
res = cl
else if abbrev(vo, 'SHR') then
res = 'SHR'
else
res = 'tape'
if abbrev(res, 'ar') ^= abbrev(dt, '00'x) ,
| abbrev(res, 'ta') ^= abbrev(c2x(left(dt, 1)), '7') ,
| (left(res, 1) >= 'A') ^= abbrev(dt, '30'x) then
say '||| mismatch cl' cl 'vo' vo 'dt' c2x(dt) 'dsn' dsn
return res
END
POS1 = POS1 + 46 /* SKIP TO RECORD END */
POS1 = POS1 + C2D(SUBSTR(m.m.work,POS1,2)) /* ADD CSITOTLN */
END
END
END
RETURN 'notFound' /* RETURN TO INVOKER */
/* copy csi begin ***************************************************
csi interface: see dfs managing catalogs appendix c
returncode/reason see message IDC3009I
**********************************************************************/
csiOpen: procedure expose m.
parse arg m, dsnMask, fields
/*_==================================================================*/
/********************************************************************
dsnMask:
% 1 character
* 0 - n character in one level
** 0 - n levels
********************************************************************/
m.m.fld.0 = words(fields)
ffix = d2c(m.m.fld.0, 2)
do x=1 to m.m.fld.0
m.m.fld.x = translate(word(fields, x))
ffix = ffix || left(m.m.fld.x, 8)
end
m.m.filt = left(dsnMask, 149) ,
|| left('Y', 3) , /* resume offset 149 */
|| ffix /* csiNumEn offset 152 */
WORKLEN = 1024
m.m.work = D2C(WORKLEN,4) || COPIES('00'X,WORKLEN-4)
m.m.pos = workLen + 1
return
endProcedure csiOpen
csiNext: procedure expose m.
parse arg m, o
usedL = C2D(SUBSTR(m.m.work,9,4)) /* GET AMOUNT OF WORK AREA USED */
ee = C2D(SUBSTR(m.m.work,9,4)) ???
px = m.m.pos
do forever
if px > usedL then do
if substr(m.m.filt, 150, 1) ^== 'Y' then do
m.m.pos = px
m.o.dsn = ''
return 0
end
reason = left('', 4)
ADDRESS LINKPGM 'IGGCSI00 reason m.'m'.filt m.'m'.work'
if rc == 0 & substr(reason, 3, 2) == '0000'x then
nop
else if rc == 4 & substr(reason, 3, 2) == '0464'x then
say 'data set entry with error'
else
call err 'call csi returns' rc,
'rc' c2d(substr(reason, 4,1)),
'reason' c2d(substr(reason, 3,1)),
'module' substr(reason, 1,2)
usedL = C2D(SUBSTR(m.m.work,9,4)) /* GET WORK AREA USED */
numFD = C2D(SUBSTR(m.m.work,13,2)) /* no flds + 1 */
if numFd <> m.m.fld.0 + 1 then
call err 'csiNumFd' numFd 'not' m.m.fld.0 '+' 1
px = 15
iterate
end
eType = substr(m.m.work, px+1, 1)
m.o.dsn = substr(m.m.work, px+2, 44)
flag = substr(m.m.work, px, 1)
/* say 'eType' eType m.o.dsn 'flag' c2x(flag) */
if eType == '0' then do
if flag ^== '00'x & flag ^== '40'x then
call err 'flag' c2x(flag) 'for catalog' m.o.dsn
px = px + 50 /* length of catalog entry */
iterate
end
else do
if ^ abbrev(x2b(c2x(flag)), '101') then
call err 'call csi entry flag' x2b(c2x(flag)),
'rc' c2d(substr(m.m.work, px+49,1)),
'reason' c2d(substr(m.m.work, px+48,1)),
'module' substr(m.m.work, px+46, 2),
'for entry' m.o.dsn,
'see qw IDC3009I'
py = px + 46
tl = c2d(substr(m.m.work, py, 2))
pl = py + 4
pf = py + m.m.fld.0 * 2 + 4
do fx = 1 to m.m.fld.0
fi = m.m.fld.fx
fl = c2d(substr(m.m.work, pl, 2))
m.o.fi = substr(m.m.work, pf, fl)
if fi = 'MGMTCLAS' then
m.o.fi = substr(m.o.fi, 3, c2d(left(m.o.fi ,2)))
else if wordPos(fi, 'COMUDSIZ NOBYTTRK') > 0 then
m.o.fi = c2d(m.o.fi)
pf = pf + fl
pl = pl + 2
end
if py + tl <> pf then
call err 'length mismatch for entry' m.o.dsn
m.m.pos = pf
return 1
end
end
endProcedure csiNext
csiArcTape: procedure expose m.
parse arg vo, cl, dt, dsn
if vo = '' then
say err '||| no volume for dsn' dsn
else if vo = 'ARCIVE' then
res = 'arcive'
else if cl <> '' then
res = cl
else if abbrev(vo, 'SHR') then
res = 'SHR'
else
res = 'tape'
if res = 'arcive' then
return res
/*if abbrev(res, 'ar') ^= abbrev(dt, '00'x) , */
if abbrev(res, 'ta') ^= abbrev(c2x(left(dt, 1)), '7') ,
| (left(res, 1) >= 'A') ^= abbrev(dt, '30'x) then
say '||| mismatch cl' cl 'vo' vo 'dt' c2x(dt) 'dsn' dsn
return res
endProcedure csiArcTape
/* copy csi end ******************************************************/