zOs/REXX.O08/VPOOL

/* rexx */
call adrIsp 'control errors return'
say adrIsp("vget (zscreen zsplit vProfile) profile", '*')
say 'got profile zscreen' zscreen 'zsplit' zsplit 'vProfile' vProfile
say adrIsp("vget (zscreen zsplit vShared vProfile) shared", '*')
say 'got shared  zscreen' zscreen 'zsplit' zsplit ,
               'vShared' vShared 'vProfile' vProfile
vShared = 'vShared ' time() 'zScreen' zScreen
say adrIsp("vput (vShared) shared")
say 'put vShared  =' vShared
vProfile = 'vProfile' time() 'zScreen' zScreen
say adrIsp("vput (vProfile) profile")
say 'put vProfile =' vProfile
exit
/* copy adrIsp begin *************************************************/
/**********************************************************************
    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
***********************************************************************/
lmdBegin: procedure
    parse arg grp, lev
    call adrIsp 'lmdinit listid(lmdId) level('lev')'
    res = adrIsp('lmdlist listid(&lmdId) option(save) group('grp')', 4)
    call adrIsp 'lmdfree listid(&lmdId)'
    if res = 0 then do
        call trc showTime() 'lmdlist save' grp lev
        call adrTso 'alloc dd('grp') shr dsn('grp'.datasets)'
        end
    else do
        call trc 'no datasets found' showTime() 'lmdlist save' grp lev
        call adrTso 'alloc dd('grp') dummy'
        end
    call readDDBegin grp
return /* end lmdBegin */

lmdNext:
    parse arg ggGrp, ggSt, withVolume
    if ^ readDD(ggGrp, ggSt) then
         return 0
    if withVolume ^== 1 then
        do ggIx=1 to value(ggSt'0')
            x = value(ggSt || ggIx, word(value(ggSt || ggIx), 1))
            end
    return 1
endSubroutin lmdNext

lmdEnd: procedure
    parse arg grp
    call readDDEnd grp
    call adrTso 'free dd('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')'
    return res
endProcedure lmmBegin

lmmEnd: procedure
parse arg lmmId opt
    call adrIsp "LMMLIST DATAID("lmmId") option(free)", 8
    call adrIsp "LMCLOSE DATAID("lmmId")"
    call adrIsp "LMFREE DATAID("lmmId")"
    return
endProcedure lmmEnd

lmmNext: procedure
parse arg lmmId opt
    if adrIsp("LMMLIST DATAID("lmmid")" ,
               "OPTION(LIST) MEMBER(Mbr)" opt, 4 8) = 0 then
        return mbr
    else
        return ''
endProcedure lmmNext

lmmRmMbr: procedure
parse arg dsn, mbrs
    mbrs = dsnGetMbr(dsn) mbrs
    pds = dsnSetMbr(dsn, )
    call adrIsp "LMINIT DATAID(lmmId) DATASET("pds") ENQ(SHRW)"
    call adrIsp "LMOPEN DATAID("lmmId") OPTION(OUTPUT) "
    err = ''
    do wx=1 to words(mbrs)
        m1 = word(mbrs, wx)
        rr = adrIsp("lmmDel dataid("lmmId") member("m1")", 0 8 12)
        if rc = 0 then
            say 'removed' m1 'from' pds
        else if rc = 8 then
            say 'not found' m1 'in' pds
        else do
            err = 'error deleting' m1 'in' pds 'rc' rr strip(zerrlm)
            say err
            leave
            end
        end
    call adrIsp "LMCLOSE DATAID("lmmId")"
    call adrIsp "LMFREE DATAID("lmmId")"
    if err <> '' then
        call err err
    return
/**********************************************************************
    adr*: address an environment
***********************************************************************/

adrIsp:
    parse arg ggIspCmd, ggRet
    address ispexec ggIspCmd
    if rc = 0 then return 0
    else if ggRet == '*' then return rc
    else if wordPOS(rc, ggRet) > 0 then return rc
    else
        call err 'adr ispExec rc' rc 'in' ggIspCmd':' strip(zerrlm)
endSubroutine adrIsp

adrEdit:
    parse arg ggEditCmd, ggRet
    address isrEdit ggEditCmd
    if rc = 0 then return 0
    else if ggRet == '*' then return rc
    else if wordPOS(rc, ggRet) > 0 then return rc
    else
        call err 'adr isrEdit rc' rc 'for' ggEditCmd
endSubroutine adrEdit

/* copy adrIsp end   *************************************************/