zOs/REXX.O13/ADRISP

/* 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 expose m.
    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 timing() 'lmdlist save' grp lev
        call adrTso 'alloc dd('grp') shr dsn('grp'.datasets)'
        end
    else do
        call trc 'no datasets found' timing() 'lmdlist save' grp lev
        call adrTso 'alloc dd('grp') dummy'
        end
    call tsoOpen grp, 'R'
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 expose m.
    parse arg grp
    call tsoClose grp
    call adrTso 'free dd('grp')'
return /* end lmdEnd */

lmd: procedure expose m.
    parse arg lev, withVol
    call lmdBegin gg1, lev
    do while lmdNext(gg1, q., withVol)
        do x=1 to q.0
           call out q.x
           end
        end
    call lmdEnd gg1
    return
endProcedure lmd
/**********************************************************************
    member list of a pds:
        call sequence x=lmmBegin(dsn) lmmNext(x) * lmmEnd(x)
***********************************************************************/
lmm: procedure expose m.
parse arg dsn
    id = lmmBegin(dsn)
    do ix=1 by 1
        m = lmmNext(id)
        if m = '' then
            leave
        call out m
        end
    call lmmEnd id
    return
endProcedure lmm

lmmBegin: procedure expose m.
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 expose m.
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 expose m.
parse arg lmmId opt
    if adrIsp("LMMLIST DATAID("lmmid")" ,
               "OPTION(LIST) MEMBER(Mbr)" opt, 4 8) = 0 then
        return strip(mbr)
    else
        return ''
endProcedure lmmNext

lmmRm: procedure expose m.
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
endProcedure lmmRm
/*--- address ispf with error checking -------------------------------*/
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

/*--- address editor with error checking -----------------------------*/
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   *************************************************/