zOs/REXX.O08/LISTCT

parse arg arg
if arg = '' then do
    call is A540769.wk.rexx
    call is A540769.BMCCAT.SQL
    call is A540769.dbx.cdl
    call is DBOF.AU01A1P.SAM15090.P0000.D07364.T192314
    call is DBOF.LFDC.AC01A1P.A002P.D08009.T080017
    call is DBOF.AU01A1P.SAM05993.P0000.D08015.T221640
    call is DBOF.AV01A1P.A030H.P0000.D08017.T014514
    end
else do
    call is "'"arg"'"
    end
exit
is:
    say arg(1) '-->' info(arg(1))
return

info: procedure
parse upper arg dsn
    call outtrap x., '*'
    address tso "listcat volume entry('"dsn"')"
    rt = rc
    call outtrap off
    /* say 'listct rc =' rt 'lines' x.0 */
    cl = ''
    vo = ''
    if word(x.1, 3) ^== dsn then
        say 'for dsn' dsn 'bad first line' x.1
    else if pos('NOT FOUND', x.1) > 0 then
        return 'notFound'
    else if word(x.1, 1)^== 'NONVSAM' then
        say 'for dsn' dsn 'bad first line' x.1
    do x=2 to x.0 while vo = '' & left(x.x, 1) = ' '
     /* say x.x */
        p = pos('MANAGEMENTCLASS-', x.x)
        if p > 0 then
            cl = strip(substr(x.x, p+16))
        p = pos('VOLSER--', x.x)
        if p > 0 then
            vo = strip(word(substr(x.x, p+6), 1), 'l', '-')
        p = pos('DEVTYPE--', x.x)
            dt = strip(word(substr(x.x, p+8), 1), 'l', '-')
        end
   /*  say 'lc' cl 'vo' vo 'dt' dt 'dsn' dsn */
    if vo = '' then
        say err 'no volume for dsn' dsn
    else if vo = 'ARCIVE' then
        res =  'arcive'
    else if cl = '' then
        res = 'tape'
    else
        res = cl
    if   abbrev(res, 'ar') ^= abbrev(dt, "X'0") ,
       | abbrev(res, 'ta') ^= abbrev(dt, "X'7") ,
       | (left(res, 1) >= 'A') ^= abbrev(dt, "X'3") then
       say 'mismatch lc' cl 'vo' vo 'dt' dt 'dsn' dsn
    return res
endProcedure info