zOs/REXX/II

/* copy ii begin ********* Installation Info *************************/
iiini: procedure expose m.
    if m.ii_ini == 1 then
        return
    m.ii_ini = 1
    m.ii_ds.org = ORG.U0009.B0106.MLEM43
    m.ii_ds.db2 = DSN.DB2
    m.ii_rz = ''
    i = 'RZ0 0 T S0 RZ1 1 A S1'  ,
        'RZX X X X2 RZY Y Y Y2 RZZ Z Z Z2'  ,
        'RQ2 Q Q Q2 RR2 R R R2 RZ2 2 B S2 RZ4 4 D S4'
    do while i <> ''
        parse var i rz ch pl sys i
        if rz <> RZ0 & rz <> RZ1 then
            m.ii_rz = strip(m.ii_rz rz)
        m.ii_rz2c.rz = ch
        m.ii_c2rz.ch = rz
        m.ii_rz2plex.rz = pl
        m.ii_plex2rz.pl = rz
        m.ii_rz2Sys.rz  = sys
        m.ii_sys2rz.sys = rz
        end
    i = 'DBTF T DTF DVTB V DTB DBOC C DOC DBTC B DBT DBIA A DIA' ,
        'DE0G E DE0 DEVG M DEV DPXG I DPX DX0G X DX0' ,
        'DPYG Y DPY DPZG N DPZ' ,
        'DBOF F DOF DVBP P DBP DP2G Q DP2 DBOL O DOL DP4G U DP4'
    do while i <> ''
        parse var i db ch mbr i
        m.ii_db2c.db = ch
        m.ii_c2db.ch = db
        m.ii_mbr2db.mbr = db
        m.ii_db2mbr.db  = mbr
        m.ii_db2Elar.db = wordPos(db, 'DVTB DVBP DEVG') > 0
        end
    m.ii_rz2db.rz0 = 'DBTC DBIA'
    m.ii_rz2db.rz1 = 'DBTF DVTB DBOC'
    m.ii_rz2db.rzx = 'DE0G DEVG DX0G DPXG'
    m.ii_rz2db.rzy = 'DE0G DEVG DPYG'
    m.ii_rz2db.rzz = 'DE0G DEVG DPZG'
    m.ii_rz2db.rq2 = 'DBOF DVBP DP2G'
    m.ii_rz2db.rr2 = 'DBOF DVBP DP2G'
    m.ii_rz2db.rz2 = 'DBOF DVBP DP2G'
    m.ii_rz2db.rz4 = 'DP4G DBOL'
    m.ii_rzDbCsmF  = 'RZ2/DVBP RR2/DVBP' /* 'RQ2/DVBP' */ ,
                     'RZZ/DEVG RZY/DEVG RZX/DEVG'
    m.ii_rzDbCsmT  = 'S25/DVBP R25/DVBP' /* 'Q25/DVBP' */ ,
                     'Z25/DEVG Y25/DEVG X25/DEVG'
    i = ''
    do rx=1 to words(m.ii_rz)
        rz = word(m.ii_rz, rx)
        i = i repAll(' 'space(m.ii_rz2db.rz, 1), ' ', ' 'rz'/')
        end
    m.ii_rzDb = space(i, 1)
    return
endProcedure iiIni

iiDS: procedure expose m.
parse arg nm
    return iiGet(ds, nm)

iiMbr2DbSys: procedure expose m.
parse arg mbr
    return iiGet(mbr2db, left(mbr, 3))

iiRz2C: procedure expose m.
parse arg rz
    return iiGet(rz2c, rz)

iiRz2P: procedure expose m.
parse arg rz
    return iiGet(rz2plex, rz)

iiRz2Dsn: procedure expose m.
parse arg rz
    return overlay('Z', rz, 2)

iiDBSys2C: procedure expose m.
parse arg db
    return iiGet(db2c, db)

iiSys2RZ: procedure expose m.
parse arg sys
    return iiGet(sys2rz, left(sys, 2))

iiRz2Sys: procedure expose m.
parse arg rz
    return iiGet(rz2sys, rz)

iiGet: procedure expose m.
parse upper arg st, key, ret
    s2 = 'II_'st
    if symbol('m.s2.key') == 'VAR' then
        return m.s2.key
    if m.ii_ini == 1 then
       if abbrev(ret, '^') then
           return substr(ret, 2)
       else
           return err('no key='key 'in II_'st, ret)
    call iiIni
    return iiGet(st, key, ret)
endProcedure iiGet

iiPut:procedure expose m.
parse upper arg rz '/' db
    rz = strip(rz)
    db = strip(db)
    call vPut 'rz', rz
    call vPut 'rzC', iiRz2C(rz)
    call vPut 'rzP', iiRz2P(rz)
    call vPut 'rzD', iiRz2Dsn(rz)
    call vPut 'dbSys', db
    if db <> '' then do
        call vPut 'dbSysC', iidbSys2C(db)
        call vPut 'dbSysElar', iiGet(db2Elar, db)
        end
    return 1
endProcedure iiPut

iiIxPut:procedure expose m.
parse arg ix
    call iiIni
    if ix > words(m.ii_rzDb) then
        return 0
    else
        return iiPut(word(m.ii_rzDb, ix))
endProcedure iiIxPut

ii2RzDb:procedure expose m.
parse arg a, forCsm
    r = ii2rzDbS(a, forCsm)
    if r \== '' then
        return r
    else
        return err('i}no rz/dbSys for' a)

ii2RzDbS:procedure expose m.
parse upper arg a, forCsm
    if pos('/', a) > 0 then
        parse var a r '/' d
    else if length(a) == 2 then
        parse var a r 2 d
    else
        parse var a d r
    myRz = sysvar(sysnode)
    call iiIni
    if r == '' then
        r2 = myRz
    else if length(r) <> 1 then
        r2 = r
    else do
        r2 = iiGet(plex2rz, r, '^')
        if r2 == '' then
            r2 = iiGet(c2rz, r, '^')
        end
    if length(d) == 4 then
        d2 = d
    else do
        if symbol('m.ii_rz2db.r2') \== 'VAR' then
            return ''
        if d == '' then do
            if myRz == 'RZ4' then
                d2 = 'DP4G'
            else if sysvar(sysnode) == 'RZX' then
                d2 = 'DX0G'
            else
                return ''
            end
        else do
            x = pos(d, m.ii_rz2db.r2)
            if x < 1 then
                return ''
            d2 = substr(m.ii_rz2db.r2,
                       , lastPos(' ', m.ii_rz2db.r2, x)+1,4)
            end
        end
    if r2 = myRz then
        return '*/'d2
    res = translate(r2'/'d2)
    if forCsm \==1 | wordPos(res, m.ii_rzDbCsmF) < 1 then
        return res
    else
        return word(m.ii_rzDbCsmT, wordPos(res, m.ii_rzDbCsmF))
endProcedure ii2RzDbS

/* copy ii end   ********* Installation Info *************************/