zOs/REXX/ZSTAT

/* rexx ----------------------------------------------------------------
   zstat a? yymm?       - in rz1,  create AyyMM mit AuftragsListe
                    alte versionen siehe weiter hinten version|||
----------------------------------------------------------------------*/
call errReset 'hi'
call err 'zstat ist deimplemeniert, bitte tso dbx zstat brauchen'
parse upper arg fun zgl
    rz = sysvar('sysNode')
    if fun = '' then
        if rz = 'RZ1' then
            fun = 'A'
        else if rz = 'RZ2' then
            fun = 'S'
    if zgl = '' then
        zgl = substr(date('s'), 3, 4)
    m.pre = 'DSN.DBX'
    m.lib = 'DSN.DBX.ZSTAT'
    aDsn = m.lib'(A'zgl')'
    sDsn = m.lib'(S'zgl')'
    if fun = 'A' then do
        if  rz <> 'RZ1' then
            call err 'zstat a... only in rz1'
        if sysDsn("'"aDsn"'") == 'OK' then
            call err aDsn "existiert schon"
        call checkAuftrag 'dsn.dbx.auftrag',
              , '20'zgl'01'  '20'zgl'20', aDsn
        end
    else if fun == 'S' then do
        if  rz <> 'RZ2' then
            call err 'zstat s... only in rz2'
        if sysDsn("'"aDsn"'") \== 'OK' then
            call err aDsn "existiert nicht"
        call stats zgl, aDsn, sDsn
        end
    else
        call errHelp 'bad fun' fun 'in arguments' fun zgl
exit

stats: procedure expose m.
parse arg zgl, aufLst, out
m.mm.verbs = '   CREATE     ALTER      DROP     '
m.mm.verb2 = m.mm.verbs 'REBIND'
m.mm.objs = 'DATABASE TABLESPACE TABLE INDEX VIEW TRIGGER SYNONYM ALIAS'
m.mm.obj2 = m.mm.objs 'UNIQUE'
m.mm.auft = ''
m.mm.count.auft = 0
m.mm.count.list = 0
m.mm.count.nact = 0
m.mm.count.rebind = 0
m.mm.count.load = 0
m.nachtragChars = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'
       /* PromotionPaths */
m.iProm.1 = 'ET IT PQ PA PR'
m.iProm.2 = 'RZ1/DBAF,RZ8/DC0G RZ1/DBTF,RZ8/DD0G,RZZ/DE0G' ,
                    'RQ2/DBOF,RR2/DBOF RR2/DBOF RZ2/DBOF'
m.iProm.3 = 'RZ8/DCVG RZ1/DVTB,RZ8/DDVG,RZZ/DEVG' ,
                    'RQ2/DVBP,RR2/DVBP RR2/DVBP RZ2/DVBP'
m.iProm.0 = 3
call readDsn aufLst, m.l.
do lx=1 to m.l.0
    au = word(m.l.lx, 1)
    a7 = left(translate(au), 7)
    if abbrev(a7, '*') | a7 = '' then
        iterate
    m.auft.a7 = au word(m.l.lx, 2)
    m.mm.auft = m.mm.auft a7
    m.mm.count.list = m.mm.count.list + 1
    end
dbSys = ''
rz = sysvar(sysNode)
do px=1 to m.iProm.0
    p1 = translate(m.iProm.px, ' ', ',')
    pc = pos(rz'/', p1)
    do while pc > 0
        ps = word(substr(p1, pc+4), 1)
        if wordPos(ps, dbSys) < 1 then
            dbSys = strip(dbSys ps)
        pc = pos(rz'/', p1,  pc+4)
        end
    end
say 'statistics for' dbSys
do ox=1 to words(m.mm.obj2)
    o1 = word(m.mm.obj2, ox)
    do vx=1 to words(m.mm.verbs)
        v1 = word(m.mm.verbs, vx)
        m.mm.count.o1.v1 = 0
        end
    end

do dx=1 to words(dbSys)
    d1 = word(dbSys, dx)
    ana = m.pre || d1'.ANA'
    if sysDsn("'"ana"'") <> 'OK' then do
        say '---' d1 'sysDsn('ana')' sysDsn("'"ana"'")
        iterate
        end
    say '---' d1
    lmm = lmmBegin(ana)
    laMbr = ''
    do forever
        m1 = lmmNext(lmm)
        if m1 == '' then
            leave
        m7 = left(m1, 7)
        if symbol('m.auft.m7') \== 'VAR' then
             iterate
        if left(m1, 7) <> left(laMbr, 7) then
            call countNachtrag mm, laMbr
        laMbr = m1
        say '---'m1 m.auft.m7
        call countSqls mm, ana'('m1')'
        end
    call countNachtrag mm, laMbr
    end
total = '--total--'
m.o.0 = 0
call mAdd o, 'Zuegelschub' zgl 'Statistik fuer' dbSys 'in' rz,
  , left('Auftraege in Liste', 19) right(m.mm.count.list, 9),
  , left('Auftraege analys''t', 19) right(m.mm.count.auft, 9),
  , left('Nachtraege', 19) right(m.mm.count.nact - m.mm.count.auft, 9),
  , left('Load', 19) right(m.mm.count.load, 9),
  , left('Rebind Package', 19) right(m.mm.count.rebind, 9),
  , , left('',19) m.mm.verbs
do vx=1 to words(m.mm.verbs)
    v1 = word(m.mm.verbs, vx)
    m.mm.count.total.v1 = 0
    m.mm.count.index.v1 = m.mm.count.index.v1 + m.mm.count.unique.v1
    end
obj3 = m.mm.objs total
do ox=1 to words(obj3)
    o1 = word(obj3, ox)
    t = left(o1, 19)
    do vx=1 to words(m.mm.verbs)
        v1 = word(m.mm.verbs, vx)
        t = t right(m.mm.count.o1.v1, 9)
        m.mm.count.total.v1 = m.mm.count.total.v1 + m.mm.count.o1.v1
        end
    call mAdd o, t
    end
say words(m.mm.auft) 'auftraege in list but not in ana' m.mm.auft
call mAdd o, words(m.mm.auft) ,
    'auftraege in list but not in ana' m.mm.auft
call writeDsn out, m.o., , 1
return
endProcedure stats

checkAuftrag: procedure expose m.
parse arg lib, von bis, aufLst
    ox = 0
    if bis == '' then
        bis = von
    lmm = lmmBegin(lib)
    ls = 0
    z0 = 0
    do mx=1
        m1 = lmmNext(lmm)
        if m1 == '' then
            leave
        call readDsn lib'('m1')', 'M.I.'
        ls = ls + m.i.0
        if mx // 100 = 0 then
            say mx m1 'z0='z0 'lines='ls
        if translate(word(m.i.2, 1)) \== 'ZUEGELSCHUB' then do
            z0 = z0 + 1
            iterate
            end
        z1 = word(m.i.2, 2)
        if z1 << von | z1 >> bis then
            iterate
        do ax=m.i.0 by -1 to 2 while translate(word(m.i.ax, 1)) ,
                     \== 'COMPARE'
            end
        ac = if(ax>2, word(m.i.ax, 2))
        ox = ox + 1
        m.o.ox = m1 ac
        end
    say (mx-1) 'members' m1
    call writeDsn aufLst, m.o., ox, 1
    return 0
endProcedure checkAuftrag

countNachtrag: procedure expose m.
parse arg m, mbr
    if mbr == '' then
        return
    nx = pos(substr(mbr, 8, 1), m.nachtragChars)
    if length(mbr) <> 8 | nx < 1 then
        call err 'bad member' mbr
    m.m.count.auft = m.m.count.auft + 1
    m.m.count.nact = m.m.count.nact + nx
    a7 = left(mbr, 7)
    wx = wordPos(a7, m.m.auft)
    if wx > 0 then
        m.m.auft = subword(m.m.auft, 1, wx-1) subword(m.m.auft, wx+1)
    else
        say a7 mbr 'not in list'
    return
endProcedcure countNachtrag

countSqls: procedure expose m.
parse arg m, dsn
    call readNxBegin nx, dsn
    do lx=1
        lp = readNx(nx)
        if lp == '' then
            leave
        li = translate(strip(m.lp))
        if li == '' | abbrev(li, '--') then
            iterate
        if abbrev(li, '.') then do
             if abbrev(li, '.CALL SNAPSHOT') then do
                 sx = lx
                 do until lp == '' | abbrev(m.lp, '.ENDDATA')
                     lx = lx + 1
                     lp = readNx(nx)
                     end
                   if lx - sx > 200 then
                       say '???snapshot' sx'-'lx 'tooLong'
                 end
             else if abbrev(li, '.CALL UTIL LOAD ') then do
                 m.m.count.load = m.m.count.load + 1
                 end
             iterate
             end
        if wordPos(word(li, 1), m.m.verb2) < 1 then
            iterate
        v = word(li, 1)
        if v = 'REBIND' then do
            m.m.count.rebind = m.m.count.rebind ,
                + (pos('PACKAGE', li) > 0)
            iterate
            end
        ox = wordPos(word(li, 2), m.m.obj2)
        if ox < 1 & (v == 'DROP' | v == 'ALTER') then
            iterate
        do wx=3 to min(5, words(li)) while ox < 1
            ox = wordPos(word(li, wx), m.m.obj2)
            end
        if ox < 1 then
            call err 'no object' m.m.obj2 'in' lx':'li
        o = word(m.m.obj2, ox)
        if 0 then
            say v o lx':' strip(li, 't')
        if \ datatype(m.m.count.o.v, 'n') ,
         | wordPos(v, m.m.verbs) < 0 then
            say '???' v o '???' li
        m.m.count.o.v = m.m.count.o.v + 1
        end
    call readNxEnd nx
    return
endProcedure countSqls

/* copy m begin ********************************************************
  we use variables as follows
    m. stem m: all global data and object data that must survive
               a procedure call  (m for memory in Memoria of B5000)
        m.<mbr>.** to avoid conflicts: every rexx Module (copy) should
               only allocate addresses m.<mbr>.** with <mbr> the name of
               the rexx module
        we pass parameters around (e.g. a=address, m=memory, st=stem)
            and the called function may use m.a or m.a.subField etc.
    gg*: local variable in subroutines without procedure
    everything else: temporary data within procedure

  every subroutine is declared as procedure expose m.
        (also if no m. variable is used, because e.g. of error handling)
  the few subroutines that cannot use procedure, should use only
        variables starting with gg
***********************************************************************/
/*--- increase m.a and return it (fail if undefined) -----------------*/
mInc: procedure expose m.
    parse arg a
    m.a = m.a + 1
    return m.a
endProcedure mInc

/*--- cut stem a to length len ---------------------------------------*/
mCut: procedure expose m.
parse arg a, len
    m.a.0 = len
    return a
endProcedure mCut

/*--- add one or several arguments to stem m.a -----------------------*/
mAdd: procedure expose m.
parse arg a
    ix = m.a.0
    do ax = 2 to arg()
        ix = ix + 1
        m.a.ix = arg(ax)
        end
    m.a.0 = ix
    return a'.'ix
endProcedure mAdd

/*--- pop last element from stem m.a ---------------------------------*/
mPop: procedure expose m.
parse arg a
    ix = m.a.0
    if ix < 1 then
        call err 'pop from empty stem' a
    m.a.0 = ix-1
    return m.a.ix
endProcedure mPop

/*--- add to m.dst.* a (sub)sequence of m.src.* ----------------------*/
mAddSt: procedure expose m.
    parse arg dst, src
    dx = m.dst.0
    do sx = 1 to m.src.0
        dx = dx + 1
        m.dst.dx = m.src.sx
        end
    m.dst.0 = dx
    return
endProcedure mAddSt

/*--- move a part of a stem ------------------------------------------*/
mMove: procedure expose m.
parse arg m, sx, dx
    if dx < sx then do
        y = dx
        do x=sx to m.m.0
            m.m.y = m.m.x
            y = y + 1
            end
        end
    else if dx > sx then do
        y = m.m.0 + dx - sx
        do x=m.m.0 by -1 to sx
            m.m.y = m.m.x
            y = y - 1
            end
        end
    m.m.0 = m.m.0 + dx - sx
    return
endProcedure mMove

/*--- strip all elements of a stem -----------------------------------*/
mStrip: procedure expose m.
parse arg st, opt
    if opt == '' then
        opt = 'b'
    do x=1 to m.st.0
        m.st.x = strip(m.st.x, opt)
        end
    return st
endProcedure mStrip

/*--- cat all elements of a stem together ----------------------------*/
mCat: procedure expose m.
parse arg st, mid
    if m.st.0 < 1 then
        return ''
    res = m.st.1
    do x=2 to m.st.0
        res = res || mid || m.st.x
        end
    return res
endProcedure mCat

/*--- notify all listeners of subject subj with argument arg --------*/
mNotify: procedure expose m.
parse arg subj, arg
    if symbol('m.m.subLis.subj') \== 'VAR' then
        call err 'subject' subj 'not registered'
    do lx=1 to m.m.subLis.subj.0
        call mNotify1 subj, lx, arg
        end
    return
endProcedure mNotify

/*--- notify the listener listener of subject subj with arg ---------*/
mNotify1: procedure expose m.
parse arg subject, listener, arg
    interpret m.m.subLis.subject.listener
    return
endProcedure mNotify1

/*--- notify subject subject about a newly registered listener
        or a new subject about previously registered listener -------*/
mNotifySubject: procedure expose m.
parse arg subject, listener
    interpret m.m.subLis.subject
    return
endProcedure mNotifySubject

/*--- register a new subject with the code for mNotifySubject -------*/
mRegisterSubject: procedure expose m.
parse arg subj, addListener
    if symbol('m.m.subLis.subj') == 'VAR' then
        call err 'subject' subj 'already registered'
    m.m.subLis.subj = addListener
    if symbol('m.m.subLis.subj.0') \== 'VAR' then do
         m.m.subLis.subj.0 = 0
         end
    else do lx=1 to m.m.subLis.subj.0
        call mNotifySubject subj, lx
        end
    return
endProcedure registerSubject

/*--- register a listener to subject subj with the code for mNotify -*/
mRegister: procedure expose m.
parse arg subj, notify
    if symbol('m.m.subLis.subj.0') \== 'VAR' then
         m.m.subLis.subj.0 = 0
    call mAdd 'M.SUBLIS.'subj, notify
    if symbol('m.m.subLis.subj') == 'VAR' then
         call mNotifySubject subj, m.m.subLis.subj.0
    return
endProcedure mRegister

mIni: procedure expose m.
    if m.m.ini = 1 then
        return
    m.m.ini = 1
    m.mAlfLC  = 'abcdefghijklmnopqrstuvwxyz'
    m.mAlfUC  = translate(m.mAlfLC)
    m.mAlfa   = m.mAlfLC || m.mAlfUC
    m.mAlfNum = m.mAlfa || '0123456789'
    m.mAlfDot = m.mAlfNum || '.'
    return
endProcedure mIni
/* copy m end *********************************************************/
/* 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 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 expose m.
    parse arg grp
    call readDDEnd 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   *************************************************/
/* copy adrTso begin *************************************************/
/*--- send ggTsoCmd to tso, fail if rc <> 0 or not listed in ggRet ---*/
adrTso:
    parse arg ggTsoCmd, ggRet
    address tso ggTsoCmd
    if rc == 0                     then return 0
    else if ggRet == '*'           then return rc
    else if wordPos(rc, ggRet) > 0 then return rc
    else
        call err 'adrTso rc' rc 'for' ggTsoCmd
return /* end adrTso */

/*--- format dsn from tso format to jcl format -----------------------*/
dsn2jcl: procedure expose m.
parse upper arg dsn ., addPrefix
    if left(dsn,1) = "'" then
        return strip(dsn, 'b', "'")
    sp = sysvar('SYSPREF')
    if sp == '' then
        sp = userid()
    cx = pos('~', dsn)
    if cx < 1 & addPrefix == 1 then
        return sp'.'dsn
    do while cx \== 0
        le = left(dsn, cx-1)
        ri = substr(dsn, cx+1)
        if right(le, 1) == '.' | left(ri, 1) == '.' then
            dsn = le || sp || ri
        else
            dsn = le || left('.', le \== '') || sp ,
                     || left('.', ri \== '') || ri
        cx = pos('~', spec, cx)
        end
    return dsn
endProcedure dsn2Jcl

/*--- format dsn from jcl format to tso format -----------------------*/
jcl2dsn: procedure expose m.
parse arg dsn .
    return "'"dsn"'"
endProcedure jcl2dsn

dsnSetMbr: procedure expose m.
parse arg dsn, mbr
     bx = pos('(', dsn)
     if bx > 0 then
         dsn = strip(left(dsn, bx-1))
     if mbr <> '' then
         dsn = dsn'('strip(mbr)')'
     return dsn
endProcedure dsnSetMbr

dsnGetMbr: procedure expose m.
parse arg dsn
     lx = pos('(', dsn)
     rx = pos(')', dsn, lx+1)
     if lx < 1 then
         return ''
     else if lx < rx then
         return substr(dsn, lx+1, rx-lx-1)
     else
         return strip(substr(dsn,lx+1))
endProcedure dsnGetMbr
/**********************************************************************
    io: read or write a dataset with the following callsequences:
        read:  readDDBegin, readDD*,  readDDEnd
        write: writeBegin,  writeDD*, writeEnd

        readDD returns true if data read, false at eof
***********************************************************************/

/*--- prepare reading from a DD --------------------------------------*/
readDDBegin: procedure expose m.
    parse upper arg ggDD
    call errAddCleanup 'call readDDEnd' ggDD', "*"'
return /* end readDDBegin */

/*--- read from DD ggDD into ggSt, return false at eof ---------------*/
readDD:
    parse arg ggDD, ggSt, ggCnt
    if ggCnt = '' then
        ggCnt = 100
    call adrTso 'execio' ggCnt 'diskr' ggDD '(stem' ggSt')', 2
    return (value(ggSt'0') > 0)
return /* end readDD */

/*--- finish reading DD  ggDD ----------------------------------------*/
readDDEnd: procedure expose m.
    parse upper arg ggDD, ggRet
    call errRmCleanup 'call readDDEnd' ggDD', "*"'
    return adrTso('execio 0 diskr' ggDD '(finis)', ggRet)
endProcedure readDDEnd

/*--- prepare writing to DD ggDD -------------------------------------*/
writeDDBegin: procedure expose m.
    parse upper arg ggDD
                  /* ensure file is erased, if no records are written */
    call adrTso 'execio' 0 'diskw' ggDD '(open)'
    call errAddCleanup 'call writeDDEnd' ggDD', "*"'
return /* end writeDDBegin */

/*--- write to gg ggDD from stem ggSt, ggCnt records -----------------*/
writeDD:
    parse arg ggDD, ggSt, ggCnt
    if ggCnt == '' then
        ggCnt = value(ggst'0')
    call adrTso 'execio' ggCnt 'diskw' ggDD '(stem' ggSt')'
    return
endSubroutine writeDD

/*--- end writing to dd ggDD (close) --------------------------------*/
writeDDEnd: procedure expose m.
parse upper arg ggDD, ggRet
    call errRmCleanup 'call writeDDEnd' ggDD', "*"'
    return adrTso('execio 0 diskw' ggDD '(finis)', ggRet)
endProcedure writeDDEnd

/*--- readNx: read next line, using buffer ---------------------------*/
/*--- begin: allocate dsnSpec and ini ------------------------ -------*/
readNxBegin: procedure expose m.
    parse arg m, m.m.dsn, m.m.dd, m.m.Cnt
    if m.m.dd = '' then
        m.m.dd = tsoDD('DDNX*')
    if m.m.cnt = '' then
        m.m.cnt = 1000
    m.m.cx = m.m.cnt + 999
    m.m.buf0x = 0
    m.m.0 = 0
    m.m.free = subword(dsnAlloc('dd('m.m.dd')' m.m.dsn), 2)
    call readDDBegin m.m.dd
    return m
endProcedure readDDNxBegin

/*--- return the stem of the next line, or '' at end -----------------*/
readNx: procedure expose m.
parse arg m
    m.m.cx = m.m.cx + 1
    if m.m.cx <= m.m.0 then
        return m'.'m.m.cx
    m.m.buf0x = m.m.buf0x + m.m.0
    if \ readDD(m.m.dd, 'M.'m'.', m.m.cnt)then
        return ''
    m.m.cx = 1
    return m'.1'
endProcedure readDDNx
/*--- return the stem of the curr line, '' at end --------------------*/
readNxCur: procedure expose m.
parse arg m
    if m.m.cx <= m.m.0 then
        return m'.'m.m.cx
    else
        return ''
endProcedure readNxCur

/*--- return the position (line number) of reader
           plus le characters of the current line (default 50) ------*/
readnxPos: procedure expose m.
parse arg m, le
    li = m'.'m.m.cx
    li = strip(m.li, 't')
    if arg() < 2 then
        le = 50
    if le < 1 then
        li = ''
    else if length(li) <= le then
        li = ':' li
    else
        li = ':' left(li, le-3)'...'
    return 'line' (m.m.buf0x + m.m.cx)li
endProcedure readnxPos

/*--- close and deallocate ------------------------------------------*/
readNxEnd: procedure expose m.
parse arg m
    call readDDEnd m.m.dd
    interpret m.m.free
    return
endProcedure readDDNxEnd

/*--- standardise a dsn spec
       word1             dsName or -
       word2             dd     or -
       word3             disp   or -
       word4 to first :  attributes in tso format
       after first :     attributes for new allocation
----------------------------------------------------------------------*/
dsnSpec: procedure expose m.
parse upper arg spec
    rr = ''      /* put leading - in separate words */
    do sx=1 while words(rr) < 3 & wx \= ''
        wx = word(spec, sx)
        do while abbrev(wx, '-') & words(rr) < 3
            wx = substr(wx, 2)
            rr = rr '-'
            end
        rr = rr wx
        end
    spec = rr subWord(spec, sx)
    na = ''
    dd = ''
    di = ''
    if left(spec, 1) = '&' then /* external spec is handled ok */
        spec = strip(substr(spec, 2))
    do wx=1 by 1
        w = word(spec, wx)
        if w = '' | abbrev(w, '.') | abbrev(w, ':') then
            leave
        else if wordPos(w, 'OLD SHR MOD NEW')>0 | abbrev(w, 'SYSO') then
            di = w
        else if w = 'CATALOG' then
            di = di w
        else if abbrev(w, 'DD(') then
            dd = substr(w, 4, length(w)-4)
        else if abbrev(w, 'DSN(') then
            na = strip(substr(w, 5, length(w)-5))
        else if na == '' then
            na = dsn2jcl(w)
        else if dd == '' then
            dd = w
        else if di == '' then
            di = w
        else
            leave
        end
    if na == '' then
        na = '-'
    else if abbrev(na, "'") then
        na = substr(na, 2, length(na)-2)
    if dd == '' then dd = '-'
    if di == '' then di = '-'
    re = subword(spec, wx)
    if abbrev(re, '.') then
        re = substr(re, 2)
    return na dd di re
endProcedure dsnSpec

/*--- alloc a dsn with dsnAlloc
          if the dsn is inuse wait and retry
          until either the allocation is successfull
          or the timeout occurs --------------------------------------*/
dsnAllocWait: procedure expose m.
parse upper arg spec, pDi, pDD, timeOut
    x = max(1, arg() - 1)
    do rt=0
        m.adrTsoAl.1 = ''
        m.adrTsoAl.2 = ''
        m.adrTsoAl.3 = ''
        call outtrap m.adrTsoAl.
        res = dsnAlloc(spec, pDi, pDD, '*')
        call outtrap off
        if \ abbrev(res, ' ') then
            return res
        msg = m.adrTsoAl.1'\n'm.adrTsoAl.2'\n'm.adrTsoAl.3
        if rt > timeOut & timeOut \== '' then
            return err('timeout allocating' spec time() '\n'msg)
        if pos('DATA SET IS ALLOCATED TO ANOTHER', msg) < 1 then
            return err('allocating' spec'\n'msg)
        say time() 'sleep and retry alloc' spec
        call sleep 1, 0
        end
endProcedure dsnAllocWait

/*--- alloc a dsn or a dd
          spec '-'<ddName>
               datasetName? disposition? '.'? attributes? (':' newAtts)?
          disp default disposition
          dd   default dd name
          retRc   erlaubte ReturnCodes (leer = 0)
          returns if ok then ddName <rexx for free> otherwise rc -----*/
dsnAlloc: procedure expose m.
parse upper arg spec, pDi, pDD, retRc
    parse value dsnSpec(spec) with na dd di rest
    if na = '-' then
        m.dsnAlloc.dsn = ''
    else
        m.dsnAlloc.dsn = na
    if na == '-' & dd \== '-' & di == '-' & rest = '' then
        return dd
    if dd == '-' & pDD \== '' then
        dd = pDD
    if dd == '-' then
        dd = 'DD*'
    dd = tsoDD(dd, '+')
    if di = '-' & pDi \== '' then
        di = pDi
    if di = '-' then
        di = 'SHR'
    else if pos('(', na) < 1 then
        nop
    else if di = 'MOD' then
        call err 'disp mod for' na
    else
        di = 'SHR'
    if pos('/', na) > 0 then
        return csmAlloc(na dd di rest, retRc)
    else
        return tsoAlloc(na dd di rest, retRc)
endProcedure dsnAlloc

/*--- find a free dd with prefix dd ----------------------------------*/
tsoDD: procedure expose m.
parse arg dd, f
    if m.err.ispf then
        address ispExec 'vget wshTsoDD shared'
    else if symbol('m.tso.tsoDD') == 'VAR' then
        wshTsoDD = m.tso.tsoDD
    else
        wshTsoDD = ''
    if f == '-' then do
        px = wordPos(dd, wshTsoDD)
        if px < 1 then
            call err 'tsoDD dd' dd 'not used' wshTsoDD
        wshTsoDD = strip(subword(wshTsoDD, 1, px-1) ,
                         subWord(wshTsoDD, px+1))
        end
    else do
        if right(dd, 1) = '*' then do
            dd = left(dd, length(dd)-1) || m.err.screen
            cx = lastPos(' 'dd, ' 'wshTsoDD)
            if cx < 1 then
                dd = dd'1'
            else do
                old = word(substr(wshTsoDD, cx), 1)
                if datatype(substr(old, length(dd)+1), 'n') then
                    dd = dd || (substr(old, length(dd)+1) + 1)
                else
                    call err 'tsoDD old' old 'suffix not numeric dd' dd
                end
            end
        if wordPos(dd, wshTsoDD) > 0 then
            call err 'tsoDD dd' dd 'already used' wshTsoDD
        if f == '+' then
            wshTsoDD = strip(wshTsoDD dd)
        end
    if m.err.ispf then
        address ispExec 'vPut wshTsoDD shared'
    m.tso.tsoDD = wshTsoDD
    return dd
endProcedure tsoDD

tsoAlloc: procedure expose m.
parse arg na dd disp rest ':' nn, retRc
    c = 'alloc dd('dd')' disp
    if na \== '-' then
        c = c "DSN('"na"')"
    else if disp = 'NEW' and nn \== '' then
        c = c dsnCreateAtts(,nn)
    call outtrap m.adrTsoAl.
    alRc = adrTso(c rest, '*')
    call outtrap off
    if alRc =  0 then do
        call errAddCleanup 'call tsoFree' dd', "*"'
        return dd 'call tsoFree' dd';'
        end
    if nn \= '' & wordPos(disp, 'OLD SHR') > 0 ,
          & sysDsn("'"m.dsnAlloc.dsn"'") == 'DATASET NOT FOUND' then do
        say 'tsoAlloc creating' c rest ':'nn
        call adrTso 'alloc dd('dd') new catalog' dsnCreateAtts(na, nn)
        call adrTso 'free  dd('dd')'
        return tsoAlloc(na dd disp rest, retRc)
        end
    do ax=1 to m.adrTsoAl.0
        say m.adrTsoal.ax
        end
    if retRc = '*' | wordPos(alRc, retRc) > 0 then
        return ' ' alRc
    call err 'tsoAlloc rc' alRc 'for' c rest
endProcedure tsoAlloc

tsoAtts: procedure expose m.
parse arg dsn
    rc = listDsi("'"dsn"' SMSINFO")
    if rc = 0 then
        mv = ''
    else if rc = 4 & sysReason = 19 then do
        mv = 'UNITCNT(30)'
        say 'multi volume' mv
        end
    else if rc ^= 0 then
        call err 'listDsi rc' rc 'reason' sysReason,
                             sysMsgLvl1 sysMsgLvl2
    al = 'CAT'
    al = ''
    if right(sysDsSms, 7) == 'LIBRARY' ,
        | abbrev(sysDsSms, 'PDS') then
         al = al 'DSNTYPE(LIBRARY)'
    if sysUnits = 'TRACK' then
        sysUnits = 'TRACKS'
    return al "DSORG("sysDSorg") MGMTCLAS("sysMgmtClass")",
        "DATACLAS("sysDataClass")" ,
        "RECFM("translate('1 2 3', ' 'sysREcFM, ' 123')")",
        "LRECL("SYSLRECL")",
        "SPACE("sysPrimary"," sysSeconds")" sysUnits mv
    /*  "blksize("sysBLkSIZE")" removed 3.4.13: let sms do the magic */
endProcedure tsoAtts

tsoFree: procedure expose m.
parse arg dd, ggRet
    call adrTso 'free dd('dd')', ggRet
    call tsoDD dd, '-'
    call errRmCleanup 'call tsoFree' dd', "*"'
    return
endProcedure tsoFree

dsnCreateAtts: procedure expose m.
parse arg dsn, atts, forCsm
    forCsm = forCsm == 1
    aU = ' 'translate(atts)
    res = ''
    if dsn \== '' then
        res = "dataset('"dsnSetMbr(dsn)"')"
    if abbrev(atts, '~') then
        return res tsoAtts(substr(atts, 2))
    if abbrev(atts, ':') then do
        parse var atts a1 atts
        rl = substr(a1, 3)
        if abbrev(a1, ':F') then do
            if rl = '' then
                rl = 80
            recfm='f b'
            end
        else do
            if rl = '' then
                rl = 32756
            recfm = substr(a1, 2, 1) 'b'
            end
        res =  res "recfm("space(recfm, 1-forCsm)") lrecl("rl")"
        end
    if pos('(', dsn) > 0 & pos(' DSNTYPE(', aU) < 1 ,
                         & pos(' DSORG(',   aU) < 1 then
        res = res 'dsntype(library) dsorg(po)'
    if pos(' MGMTCLAS(', aU) < 1 then
        res = res 'mgmtclas(COM#A091)'
    if pos(' SPACE(', aU) < 1 then
        res = res 'space(10, 1000) cyl' || copies('inder', forCsm)
    return res atts
endProcedure dsnCreateAtts
/*--- check if a dataset is archive ------------------------------------
          returns 'ok'                    if dataset on disk
                  'not'                   if dataset is not catalogued
                  'arc'                   if dataset archived
                  listDsi errorMsg        otherwise ------------------*/
dsnArc: procedure expose m.
parse upper arg dsn
    lc = listDsi("'"strip(dsn)"' noRecall")
    if lc = 0 then
        return 'ok'
    else if lc=4 & sysReason = 19 then  /* multiple volumes */
        return 'ok'
    else if lc=16 & sysReason = 5 then
        return 'notCat'
    else if lc=16 & sysReason = 9 then
        return 'arc'
    else
        return 'listDsi cc='lc', sysReason='sysReason ,
                          'm2='sysMsgLvl2', m1='sysMsgLvl1
endProcedure dsnArc
/*--- read the dataset specified in ggDsnSpec to stem ggSt -----------*/
readDSN:
parse arg ggDsnSpec, ggSt
    ggAlloc = dsnAlloc(ggDsnSpec, 'SHR', 'readDsN')
    call adrTso 'execio * diskr' word(ggAlloc, 1) '(stem' ggSt' finis)'
    interpret subword(ggAlloc, 2)
    return
endSubroutine readDsn

/*--- write the dataset specified in ggDsnSpec from stem ggSt
          write ggCnt records if not empty otherwise ggst0
          if ggSay 1 then say ... records written to ... -------------*/
writeDSN:
parse arg ggDsnSpec, ggSt, ggCnt, ggSay
    if ggCnt == '' then
        ggCnt = value(ggst'0')
    ggAlloc = dsnAlloc(ggDsnSpec, 'OLD', 'readDsN')
    call adrTso 'execio' ggCnt 'diskw' word(ggAlloc, 1) ,
            '(stem' ggSt 'open finis)'
    interpret subword(ggAlloc, 2)
    if ggSay == 1 | m.debug == 1 then
       say ggCnt 'records written to' ggDsnSpec
    return
endSubroutine writeDsn

copyDSN: procedure expose m.
parse arg frSpec, toSpec, ggSay
    frDD = dsnAlloc(frSpec, 'SHR', 'FRDD')
    toDD = dsnAlloc(toSpec, 'OLD', 'TODD')
    call readDDBegin word(frDD, 1)
    call writeDDBegin word(toDD, 1)
    cnt = 0
    do while readDD(word(frDD, 1), r.)
        call writeDD word(toDD, 1), r.
        cnt = cnt + r.0
        end
    call readDDEnd word(frDD, 1)
    call writeDDEnd word(toDD, 1)
    interpret ';' subword(frDD, 2) '; ; ;' subword(toDD, 2)
    if ggSay == 1 | m.debug == 1 then
       say cnt 'records copied from' frSpec 'to' to toSpec
    return
endSubroutine writeDsn
/* copy adrTso end ****************************************************/
/* copy err begin *** errorhandling, messages, help    ****************/
errIni: procedure expose m.
    if m.err.ini == 1 then
        return
    m.err.ini     = 1
    m.err.handler = ''
    m.err.cleanup = ';'
    m.err.opt     = ''
    parse source m.err.os .
    m.err.ispf    = 0
    m.err.screen  = ''
    if m.err.os \== 'LINUX' then
        if sysVar('sysISPF') = 'ACTIVE' then do
            m.err.ispf = 1
            address ispExec 'vget zScreen shared'
            m.err.screen = zScreen
            end
    return
endProcedure errIni

/* configure err -----------------------------------------------------*/
errReset: procedure expose m.
    call errIni
    parse arg m.err.opt, m.err.handler
    if pos('I', translate(m.err.opt)) > 0 & m.err.ispf then
        address ispExec 'control errors return'
    return
endSubroutine errReset

/*--- error routine: abend with message ------------------------------*/
err:
    parse arg ggTxt, ggOpt
    call errIni
    drop err handler cleanup opt call return
    if ggOpt == '' & m.err.handler \== '' then
        interpret m.err.handler
    call errSay 'f}'ggTxt
    call errCleanup
    if ggOpt == '' then
        ggOpt = m.err.opt
    upper ggOpt
    if pos('T', ggOpt) > 0  then do
        trace ?r
        say 'trace ?r in err'
        end
    if pos('H', ggOpt) > 0 & m.err.eCat == 'f' then do
        call errSay ' }errorhandler exiting with divide by zero' ,
                                   'to show stackHistory'
        x = 1 / 0
        end
    call errSay ' }errorhandler exiting with exit(12)'
    exit errSetRc(12)
endSubroutine err

/*--- set rc for ispf: -------------------------------------------------
    if a cmd is run by ispStart, its RC is ignored,
         but ISPF passes the value of the shared variable zIspfRc
         back as return code
----------------------------------------------------------------------*/
errSetRc: procedure expose m.
parse arg zIspfRc
    if m.err.ispf then
        address ispExec vput 'zIspfRc' shared
    return zIspfRc
endProcedure errSetRc

/*--- error routine: user message cleanup exit -----------------------*/
errAddCleanup: procedure expose m.
parse arg code
    call errIni
        /* concatenate backwards, then it is executed also backwards */
    m.err.cleanup = ';'code || m.err.cleanup
    return
endProcedure errAddCleanup

errRmCleanup: procedure expose m.
parse arg code
    call errIni
    cx = pos(';'code';', m.err.cleanup)
    if cx > 0 then
        m.err.cleanup = left(m.err.cleanup, cx) ,
                     || substr(m.err.cleanup, cx + length(code)+2)
    return
endProcedure errRmCleanup

errCleanup: procedure expose m.
    call errIni
    errCleanup = m.err.cleanup
    if errCleanup = ';' then
        return
    m.err.cleanup = ';'
    say 'err cleanup begin' errCleanup
    interpret errCleanup
    say 'err cleanup end' errCleanup
    return
endProcedure errCleanup

/*--- say an errorMessage msg with pref and linesplits --------------*/
errSay: procedure expose m.
parse arg msg
    return saySt(errMsg(msg))

/*--- prefix an errormessage with pref,
          split it into lines at \n to stem m.err -------------------*/
errMsg: procedure expose m.
parse arg msg
    m.err.eCat = 'f'
    do while substr(msg, 2, 1) == '}'
        parse var msg m.err.eCat '}' msg
        end
    if m.err.eCat <> '' then do
       parse source . . ggS3 .                       /* current rexx */
       pTxt = ',error,fatal error,input error,syntax error,warning,'
       px = pos(','m.err.eCat, pTxt)
       if px < 1 then do
           m.err.eCat = 'f'
           px = pos(','m.err.eCat, pTxt)
           end
       msg = substr(pTxt, px+1, pos(',', pTxt, px+2)-px-1) ,
             'in' ggS3':' msg
       end
    return splitNl(err, msg)           /* split lines at \n */
endProcedure errMsg

splitNL: procedure expose m.
parse arg st, msg
    bx = 1
    do lx=1 to 20
        ex = pos('\n', msg, bx)
        if ex < bx then
            leave
        m.st.lx = substr(msg, bx, ex-bx)
        bx = ex+2
        end
    m.st.lx = substr(msg, bx)
    m.st.0 = lx
    return st
endProcedure splitNL

/*--- say (part of) the lines of a stem ----------------------------*/
saySt: procedure expose m.
parse arg st, fx, tx
    do lx=word(fx 1, 1) to word(tx m.st.0, 1)
        say m.st.lx
        end
    return st
endProcedure saySt

/*--- out (part of) the lines of a stem ----------------------------*/
outSt: procedure expose m.
parse arg st, fx, tx
    do lx=word(fx 1, 1) to word(tx m.st.0, 1)
        call out m.st.lx
        end
    return st
endProcedure outSt

/*--- say a trace message if m.trace is set --------------------------*/
debug: procedure expose m.
parse arg msg
    if m.debug == 1 then
        say 'debug:' msg
    return
endProcedure debug

/*--- output a trace if m.trace is set -------------------------------*/
trc: procedure expose m.
parse arg msg
    if m.trace == 1 then
        call out 'trc:' msg
    return
endProcedure trc

/*--- assert that the passed rexx expression evaluates to true -------*/
assert:
    interpret 'assertRes =' arg(1)
    if assertRes \==1 then
        call err 'assert failed' arg(1) '==>' assertRes':' arg(2)
    return
endProcedure assert

/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure expose m.
parse arg msg
    call errSay 'i}'msg
    call help 0
    call err 'i}'msg
endProcedure errHelp

/*--- display the first comment block of the source as help ----------*/
help: procedure expose m.
parse arg doClear
    if doClear \== 0 then
        address tso 'clear'
    parse source . . s3 .
    say right(' help for rexx' s3, 72, '*')
    do lx=1 while pos('/*', sourceLine(lx)) < 1
        if lx > 10 then
            return err('initial commentblock not found for help')
        end
    doInc = 1
    ho = m.err.helpOpt
    do lx=lx+1 to sourceline() while pos('*/', sourceline(lx)) = 0
        li = strip(sourceLine(lx), 't')
        cx = lastPos('{', li)
        if cx > 0 then do
            if length(ho) = 1 then
                doInc = cx = length(li) | pos(ho, li, cx+1) > 0
            li = left(li, cx-1)
            end
        if doInc then
            say li
        end
    say right(' end help for rexx' s3, 72, '*')
    return 4
endProcedure help

/* copy err end   *****************************************************/
/* copy ut begin  *****************************************************/
/*--- if function  warning all3 arguments get evaluated|
                   e.g if(x=0, 'infinity', 1/0) will fail| -----------*/
if: procedure expose m.
parse arg co, ifTrue, ifFalse
    if co then
        return ifTrue
    else
        return ifFalse
endProcedure if
/*--- embedded ASSignement:
      assign the second argument to the variable with name in first arg
      and return the value assigned ----------------------------------*/
ass:
    call value arg(1), arg(2)
    return arg(2)
/*--- embedded ASSignement only if NotNull:
      assign the second argument to the variable with name in first arg
      if the second arg is not null, return new value ---------------*/
assIf:
    if arg(2) == '' then
        return value(arg(1))
    call value arg(1), arg(2)
    return arg(2)

/*--- return first nonNull argument ---------------------------------*/
nn:
    if arg(1) \== '' then
        return arg(1)
    if arg(2) \== '' then
        return arg(2)
    call err 'nn() both args empty'

/*--- embedded ASSignement return NotNull:
      assign the second argument to the variable with name in first arg
      and return 1 if value not null, 0 if null ----------------------*/
assNN:
    call value arg(1), arg(2)
    return arg(2) \== ''

/*--- return current time and cpu usage ------------------------------*/
timing: procedure expose m.
return return time() 'ela='time('E') 'cpu='sysvar('syscpu'),
            'su='sysvar('syssrv')

timingTest: procedure expose m.
    say 'begin' timing()  sysvar('sysnode')
    do 30000000
       end
    say 'end  ' timing()
return

/*--- sleep several seconds ------------------------------------------*/
sleep: procedure expose m.
parse arg secs, sayIt
    if sayit <> 0 then
        say 'sleeping' secs 'secs' time()
    CALL SYSCALLS 'ON'
    ADDRESS SYSCALL "sleep" secs
    CALL SYSCALLS 'OFF'
    if sayit <> 0 then
        say 'slept' secs 'secs' time()
    return
endProcedure sleep

/*--- elongate inp with spaces up to given len -----------------------*/
elong: procedure expose m.
parse arg inp, len
    if length(inp) >= len then
        return inp
    return left(inp, len)
endProcedure elong

/*--- quote string txt using quoteChar qu ("""" ==> ") ---------------*/
quote: procedure expose m.
parse arg txt, qu
    if qu = '' then
        qu = '"'
    res = qu
    ix = 1
    do forever
        qx = pos(qu, txt, ix)
        if qx = 0 then
            return res || substr(txt, ix) || qu
        res = res || substr(txt, ix, qx-ix) || qu || qu
        ix = qx + length(qu)
        end
endProcedure quote

/*--- return the count of occurrences of needle in heyStack ----------*/
posCount: procedure expose m.
parse arg needle, hayStack, start, fin
    if start = '' then
        start = 1
    if fin = '' then
        fin = length(hayStack) + 1 - length(needle)
    do cnt = 0 by 1
        start = pos(needle, haystack, start)
        if start < 1 | start > fin then
             return cnt
        start = start + length(needle)
        end
endProcedure posCount

repAll: procedure expose m.
parse arg src, w, new
    res = ''
    cx = 1
    do forever
        nx = pos(w, src, cx)
        if nx < 1 then
            return res || substr(src, cx)
        res = res || substr(src, cx, nx-cx) || new
        cx = nx + length(w)
        end
endProcedure repAll

repAllWords: procedure expose m.
parse arg src, w, new
    res = ''
    wx = 0
    cx = 1
    do forever
        wx = wordPos(w, src, wx+1)
        if wx < 1 then
            return res || substr(src, cx)
        nx = wordindex(src, wx)
        res = res || substr(src, cx, nx-cx) || new
        cx = nx + length(w)
        end
endProcedure repAllWords
/* copy ut end ********************************************************/
----- zStat Old ------------------------------------------------------*/
/*REXX*/

TRACE 0

ADDRESS ISPEXEC                      /* ISPEXEC-SERVICE ADRESSIEREN*/

ADDRESS TSO 'SUBCOM DSNREXX'               /*HOST CMD ENV AVAILABLE*/
IF RC THEN                                 /*NO, LET'S MAKE ONE*/
S_RC = RXSUBCOM('ADD','DSNREXX','DSNREXX') /*ADD HOST CMD ENV*/
IF RC ^= 0 & RC^= 1 THEN CALL SQLCA(PREPARE DSNREXX)

ORDERFILE = 'DSN.DBX.AUFTRAG'
DDLFILE   = 'DSN.DBX.CDL'
WSLFILE   = 'DSN.DBA.CLON.WSLSRC'
INTENTION = ' '
SEARCH_ZS = 'NO DATE SPECIFIED'
WORKLIST  = 'ALL FOR SPECIFIED MIGRATION-DATE'

ZS_MEMBER = 'N'
MEMBNAME  = ''
ZSMEMBER  = ''
DDLMEMBER = ''
WSLMEMBER = ''
PREVIOUS_MEMBER = ''    /* UM (UNNÖTIGE) DOPPELTE COMPARES OHNE
                           SCHREIBEN EINES CDL MEMBERS AUSZUSCHLIESSEN.
                           STATISTIKEN WÜRDEN SONST VERFÄLSCHT DA
                           DOPPELTE ZÄHLUNG DER DDL CHANGES   */

APPLIDFILE = ''
GEBIETFILE = ''
DESCRFILE  = ''

COLLECT_GEBIET     = 'N'
GEBIET             = ''
GEBIET_VDPS        = ''
GEBIET_COUNT       = 0
GEBIET_PREV        = ''
OUTPUT_APPLID      = ''
OUTPUT_APPLID_DESC = ''

INPUTC = 1
MEMB_C = 1
COUNT  = 1
MEMBER_FOUND = 'N'

CHANGE_REQUESTS.0 = 0
COMP_NACHTRAEGE.0 = 0
VERS_NACHTRAEGE.0 = 0

CRE_DB_STAT.0  = 0
CRE_TS_STAT.0  = 0
CRE_TBL_STAT.0 = 0
CRE_IX_STAT.0  = 0
CRE_UIX_STAT.0 = 0
CRE_VW_STAT.0  = 0
CRE_TR_STAT.0  = 0
CRE_ALI_STAT.0 = 0
CRE_SYN_STAT.0 = 0

ALTER_STAT.0       = 0
ALTER_ADMIN_STAT.0 = 0
COMMENT_STAT.0     = 0
LABEL_STAT.0       = 0

DROP_DB_STAT.0  = 0
DROP_TS_STAT.0  = 0
DROP_TBL_STAT.0 = 0
DROP_IX_STAT.0  = 0
DROP_VW_STAT.0  = 0
DROP_TR_STAT.0  = 0
DROP_ALI_STAT.0 = 0
DROP_SYN_STAT.0 = 0

ADDRESS TSO "CLEAR" /* BILDSCHIRM LÖSCHEN */

CALL READ_APPLID_FILE

SAY 'AN WELCHER AUSWERTUNGSART SIND SIE INTERESSIERT?'
SAY '   -> FUER EINEN OFFIZIELLEN ZUEGELSCHUB - "M" + "ENTER"'
SAY '   -> FUER SPEZIELLE WORKLISTEN          - "S" + "ENTER"'
PULL INTENTION

IF INTENTION <> 'M' & INTENTION <> 'S' THEN DO
   SAY 'FALSCHE EINGABE - PROGRAM WIRD BEENDET...'
   EXIT;
END


/* VERARBEITUNG FÜR INTENTION = M */
IF INTENTION = 'M' THEN DO

   SAY 'FUER WELCHES ZUEGELSCHUBDATUM MOECHTEN SIE IHRE AUSWERTUNGEN'
   SAY 'ERSTELLEN LASSEN? - EINGABE-FORMAT: YYYYMMDD'
   PULL SEARCH_ZS

   IF SEARCH_ZS = ' ' THEN DO
      SAY 'KEIN DATUM EINGEGEBEN - PROGRAM WIRD BEENDET...'
      EXIT;
   END

   SAY 'DETAILS FÜR WORKLISTEN ANZEIGEN?'
   SAY '   -> JA   - "J" + "ENTER"'
   SAY '   -> NEIN - "N" + "ENTER"'
   PULL SHOWDETAILS

   IF SHOWDETAILS <> 'J' & SHOWDETAILS <> 'N' THEN DO
      SAY 'FALSCHE EINGABE - PROGRAM WIRD BEENDET...'
      EXIT;
   END

   ADDRESS TSO "CLEAR" /* BILDSCHIRM LÖSCHEN */

   SAY '   AUFTRAGS-DATEI:' ORDERFILE
   SAY '        DDL-DATEI:' DDLFILE
   SAY '        WSL-DATEI:' WSLFILE
   SAY 'ZUEGELSCHUB-DATUM:' SEARCH_ZS
   SAY '         WORKLIST:' WORKLIST
   SAY ' '

   "LMINIT DATAID(MEMVAR) DATASET('"ORDERFILE"') ENQ(SHR)"
   "LMOPEN DATAID(&MEMVAR) OPTION(INPUT)"

   CALL SEARCH_ZSMEMBER
   "LMFREE DATAID(&MEMVAR)"

   "LMINIT DATAID(MEMVAR) DATASET('"DDLFILE"') ENQ(SHR)"
   "LMOPEN DATAID(&MEMVAR) OPTION(INPUT)"

   CALL COLLECT_DDLFILE_STATS
   "LMFREE DATAID(&MEMVAR)"

   "LMINIT DATAID(MEMVAR) DATASET('"WSLFILE"') ENQ(SHR)"
   "LMOPEN DATAID(&MEMVAR) OPTION(INPUT)"

   CALL COLLECT_WSLFILE_STATS
   "LMFREE DATAID(&MEMVAR)"

   COLLECT_GEBIET = 'Y'

   "LMINIT DATAID(MEMVAR) DATASET('"DDLFILE"') ENQ(SHR)"
   "LMOPEN DATAID(&MEMVAR) OPTION(INPUT)"

   CALL COLLECT_DDLFILE_STATS
   "LMFREE DATAID(&MEMVAR)"

   "LMINIT DATAID(MEMVAR) DATASET('"WSLFILE"') ENQ(SHR)"
   "LMOPEN DATAID(&MEMVAR) OPTION(INPUT)"

   CALL COLLECT_WSLFILE_STATS
   "LMFREE DATAID(&MEMVAR)"

END

/* VERARBEITUNG FÜR INTENTION = S */
IF INTENTION = 'S' THEN DO

   SAY 'FUER WELCHES ZUEGELSCHUBDATUM MOECHTEN SIE IHRE AUSWERTUNGEN'
   SAY 'ERSTELLEN LASSEN? - EINGABE-FORMAT: YYYYMMDD, YYYYMM, YYYY, ...'
   SAY '"ENTER"-TASTE FUER KEIN SPEZIELLES DATUM.'
   PULL SEARCH_ZS

   IF SEARCH_ZS = ' ' THEN DO
      SEARCH_ZS = 'NO DATE SPECIFIED'
   END

   SAY 'BITTE GEBEN SIE IHRE WORKLISTE(N) EIN:'
   SAY 'MEHRERE WORKLISTEN ODER WILDCARDS SIND MOEGLICH.'
   SAY 'EINGABE DURCH DRUECKEN DER "ENTER"-TASTE ABSCHLIESSEN.'
   SAY 'FORMAT: MF01001W, MF01, MF, ...'
   PULL WORKLIST
   WORKLIST.INPUTC = WORKLIST
   DO WHILE WORKLIST <> ' ' /* REPEAT INPUT UNTIL BLANK */
      INPUTC = INPUTC + 1
      PULL WORKLIST
      WORKLIST.INPUTC = WORKLIST
   END

   IF WORKLIST.1 = '' THEN DO
      SAY 'KEINE WORKLISTE SPEZIFIZIERT - PROGRAMM WIRD BEENDET...'
      EXIT;
   END

   SAY 'DETAILS FÜR WORKLISTEN ANZEIGEN?'
   SAY '   -> JA   - "J" + "ENTER"'
   SAY '   -> NEIN - "N" + "ENTER"'
   PULL SHOWDETAILS

   IF SHOWDETAILS <> 'J' & SHOWDETAILS <> 'N' THEN DO
      SAY 'FALSCHE EINGABE - PROGRAM WIRD BEENDET...'
      EXIT;
   END

   ADDRESS TSO "CLEAR" /* BILDSCHIRM LÖSCHEN */

   SAY '  AUFTRAGS-DATEI:' ORDERFILE
   SAY '       DDL-DATEI:' DDLFILE
   SAY '       WSL-DATEI:' WSLFILE
   SAY 'ZUEGELSCHUB-DATUM:' SEARCH_ZS
   SAY '        WORKLIST:' WORKLIST
   SAY ' '
   X = 1
   DO UNTIL X >= INPUTC
      SAY '      WORKLIST:' WORKLIST.X
      X = X + 1
   END
   SAY ' '

   "LMINIT DATAID(MEMVAR) DATASET('"ORDERFILE"') ENQ(SHR)"
   "LMOPEN DATAID(&MEMVAR) OPTION(INPUT)"

   CALL SEARCH_ZSMEMBER
   "LMFREE DATAID(&MEMVAR)"

   "LMINIT DATAID(MEMVAR) DATASET('"DDLFILE"') ENQ(SHR)"
   "LMOPEN DATAID(&MEMVAR) OPTION(INPUT)"

   CALL COLLECT_DDLFILE_STATS
   "LMFREE DATAID(&MEMVAR)"

   "LMINIT DATAID(MEMVAR) DATASET('"WSLFILE"') ENQ(SHR)"
   "LMOPEN DATAID(&MEMVAR) OPTION(INPUT)"

   CALL COLLECT_WSLFILE_STATS
   "LMFREE DATAID(&MEMVAR)"

END

IF MEMBER_FOUND = 'Y' THEN DO
   CALL OUTPUT_STATS
   EXIT;
END

IF MEMBER_FOUND = 'N' THEN DO
   SAY ' '
   SAY 'KEINE DATEN FUER EINGEGEBENE PARAMETER GEFUNDEN|'
   SAY ' '
   SAY '   AUFTRAGS-DATEI:' ORDERFILE
   SAY '        DDL-DATEI:' DDLFILE
   SAY '        WSL-DATEI:' WSLFILE
   SAY 'ZUEGELSCHUB-DATUM:' SEARCH_ZS
   SAY '         WORKLIST:' WORKLIST
   SAY ' '
   SAY 'PROGRAMM WIRD BEENDET...'
   EXIT;
END

/******************************************************************/
READ_APPLID_FILE:
/******************************************************************/

FILECOUNTER = 1

ADDRESS DSNREXX "CONNECT "DBOC
        IF SQLCODE <> 0 THEN CALL SQLCA

SQL_S1="SELECT GEBIETSPOINTER    ",
       "      ,GEBPOINT_BEZEICHNUNG                         ",
       "      ,BANKANWENDUNG                                ",
       "  FROM RZ2DD.TACCT_GEBPOINT;                        "

ADDRESS DSNREXX "EXECSQL DECLARE C1 CURSOR FOR S1 ";
IF (SQLCODE < 0) THEN CALL SQLCA

ADDRESS DSNREXX "EXECSQL PREPARE S1 FROM :SQL_S1 ";
IF (SQLCODE < 0) THEN CALL SQLCA

ADDRESS DSNREXX "EXECSQL OPEN C1 ";
IF (SQLCODE < 0) THEN CALL SQLCA

DO UNTIL (SQLCODE^=0)
   ADDRESS DSNREXX ,
          "EXECSQL FETCH C1 INTO :H0,:H1,:H2"

   GEBIETFILE.FILECOUNTER = H0
   DESCRFILE.FILECOUNTER  = H1
   APPLIDFILE.FILECOUNTER = H2

   FILECOUNTER = FILECOUNTER + 1

END

ADDRESS DSNREXX "DISCONNECT";
IF SQLCODE <> 0 THEN CALL SQLCA

RETURN;

/******************************************************************/
SEARCH_ZSMEMBER:
/******************************************************************/

IF INTENTION = 'M' THEN DO
   DO FOREVER
      "LMMLIST DATAID(&MEMVAR) OPTION(LIST) MEMBER(MEMBNAME)"
      IF RC > 0 THEN LEAVE            /* END OF FILE            */
      CALL READ_MEMB
   END
END

IF INTENTION = 'S' THEN DO
   DO FOREVER
      "LMMLIST DATAID(&MEMVAR) OPTION(LIST) MEMBER(MEMBNAME)"
      IF RC > 0 THEN LEAVE            /* END OF FILE            */

      Y = 1
      DO UNTIL Y > INPUTC
         IF POS(WORKLIST.Y,MEMBNAME) > 0 THEN DO
            CALL READ_MEMB
         END
      Y = Y + 1
      END
   END
END

RETURN;


/******************************************************************/
READ_MEMB:
/******************************************************************/

"LMMFIND DATAID(&MEMVAR) MEMBER("MEMBNAME")"

DO FOREVER
   "LMGET DATAID(&MEMVAR) MODE(INVAR) DATALOC(LINE)
          DATALEN(LINELEN) MAXLEN(160)"
   IF RC > 0 THEN LEAVE            /* END OF FILE                */

   PARSE UPPER VAR LINE V1 V2 V3 V4 V5 V6 V7 V8 V9

   IF INTENTION = 'M' & POS(SEARCH_ZS,V2) > 0 THEN DO
      MEMBER_FOUND = 'Y'
      IF SHOWDETAILS = 'J' THEN DO
         SAY ' '
         SAY MEMBNAME '- AUSZUFUEHREN FUER ZS AM ' V2 ' UM ' V3
      END
      ZS_MEMBER = 'Y'
      GEBIET = SUBSTR(MEMBNAME,1,2)
      GEBIET_VDPS = SUBSTR(MEMBNAME,1,4)

      IF GEBIET <> GEBIET_PREV THEN DO
         GEBIET_COUNT = GEBIET_COUNT + 1
         GEBIET.GEBIET_COUNT = SUBSTR(MEMBNAME,1,2)
         GEBIET_PREV         = SUBSTR(MEMBNAME,1,2)
         /* INIT VARIABLE */
         CHANGE_REQUESTS.GEBIET_COUNT  = 0
         COMP_NACHTRAEGE.GEBIET_COUNT  = 0
         VERS_NACHTRAEGE.GEBIET_COUNT  = 0
         CRE_DB_STAT.GEBIET_COUNT      = 0
         CRE_TS_STAT.GEBIET_COUNT      = 0
         CRE_TBL_STAT.GEBIET_COUNT     = 0
         CRE_IX_STAT.GEBIET_COUNT      = 0
         CRE_UIX_STAT.GEBIET_COUNT     = 0
         CRE_VW_STAT.GEBIET_COUNT      = 0
         CRE_TR_STAT.GEBIET_COUNT      = 0
         CRE_ALI_STAT.GEBIET_COUNT     = 0
         CRE_SYN_STAT.GEBIET_COUNT     = 0
         ALTER_STAT.GEBIET_COUNT       = 0
         ALTER_ADMIN_STAT.GEBIET_COUNT = 0
         COMMENT_STAT.GEBIET_COUNT     = 0
         LABEL_STAT.GEBIET_COUNT       = 0
         DROP_DB_STAT.GEBIET_COUNT     = 0
         DROP_TS_STAT.GEBIET_COUNT     = 0
         DROP_TBL_STAT.GEBIET_COUNT    = 0
         DROP_IX_STAT.GEBIET_COUNT     = 0
         DROP_VW_STAT.GEBIET_COUNT     = 0
         DROP_TR_STAT.GEBIET_COUNT     = 0
         DROP_ALI_STAT.GEBIET_COUNT    = 0
         DROP_SYN_STAT.GEBIET_COUNT    = 0
         /* INIT VARIABLE */
         DO APPLID_CHECK = 1 TO FILECOUNTER
            IF GEBIET_VDPS = 'VDPS' THEN DO
               GEBIET = 'VV'
            END
            IF GEBIET = GEBIETFILE.APPLID_CHECK THEN DO
               OUTPUT_APPLID.GEBIET_COUNT = APPLIDFILE.APPLID_CHECK
               OUTPUT_APPLID_DESC.GEBIET_COUNT = DESCRFILE.APPLID_CHECK
            IF SHOWDETAILS = 'J' THEN DO
               SAY '---> GEBIETSPOINTER:' GEBIET
               SAY '---> APPLICATION-ID:' OUTPUT_APPLID.GEBIET_COUNT
               SAY '--->                ' OUTPUT_APPLID_DESC.GEBIET_COUNT
            END
            END
         END
      END
      IF GEBIET = GEBIET_PREV THEN DO
         GEBIET_PREV = SUBSTR(MEMBNAME,1,2)
         CHANGE_REQUESTS.GEBIET_COUNT = CHANGE_REQUESTS.GEBIET_COUNT + 1
         CHANGE_REQUESTS.0 = CHANGE_REQUESTS.0 + 1
      END
   END

   IF SEARCH_ZS = 'NO DATE SPECIFIED' THEN DO
      IF INTENTION = 'S' & V1 = 'ZUEGELSCHUB' THEN DO
         MEMBER_FOUND = 'Y'
         IF SHOWDETAILS = 'J' THEN DO
            SAY ' '
            SAY MEMBNAME '- AUSZUFUEHREN FUER ZS AM ' V2 ' UM ' V3
         END
         CHANGE_REQUESTS.0 = CHANGE_REQUESTS.0 + 1
         ZS_MEMBER = 'Y'
      END
   END

   IF SEARCH_ZS <> 'NO DATE SPECIFIED' THEN DO
      IF INTENTION = 'S' & POS(SEARCH_ZS,V2) > 0 THEN DO
         MEMBER_FOUND = 'Y'
         IF SHOWDETAILS = 'J' THEN DO
            SAY ' '
            SAY MEMBNAME '- AUSZUFUEHREN FUER ZS AM ' V2 ' UM ' V3
         END
         CHANGE_REQUESTS.0 = CHANGE_REQUESTS.0 + 1
         ZS_MEMBER = 'Y'
      END
   END

   IF V1 = 'COMPARE' & ZS_MEMBER = 'Y' THEN DO
      DDLMEMBER.MEMB_C = SUBSTR(MEMBNAME,1,7) V2
      DDLMEMBER.MEMB_C = SPACE(DDLMEMBER.MEMB_C,0)
      IF SHOWDETAILS = 'J' THEN DO
         SAY MEMBNAME '- COMPARE' V2 'AM' V5 'UM' V6 ,
             ' - DELTA FILE:' DDLMEMBER.MEMB_C
      END
      IF PREVIOUS_MEMBER <> DDLMEMBER.MEMB_C THEN DO
         PREVIOUS_MEMBER = DDLMEMBER.MEMB_C
         MEMB_C = MEMB_C + 1
      END

      IF PREVIOUS_MEMBER = DDLMEMBER.MEMB_C THEN DO
         PREVIOUS_MEMBER = DDLMEMBER.MEMB_C
      END
      COMP_NACHTRAEGE.0 = COMP_NACHTRAEGE.0 + 1
      COMP_NACHTRAEGE.GEBIET_COUNT = COMP_NACHTRAEGE.GEBIET_COUNT + 1
   END

   IF V1 = 'VERSION' & ZS_MEMBER = 'Y' THEN DO
      WSLMEMBER_ORIG = SUBSTR(MEMBNAME,1,7) 'Q'
      IF SHOWDETAILS = 'J' THEN DO
         SAY MEMBNAME '- VERSION' V2 'AM' V5 'UM' V6
      END
      VERS_NACHTRAEGE.0 = VERS_NACHTRAEGE.0 + 1
      VERS_NACHTRAEGE.GEBIET_COUNT = VERS_NACHTRAEGE.GEBIET_COUNT + 1
      VERSION = 'Y'
   END

END

IF ZS_MEMBER = 'Y' & VERSION = 'Y' THEN DO
   WSLMEMBER.COUNT = SUBSTR(MEMBNAME,1,7) 'Q'
   WSLMEMBER.COUNT = SPACE(WSLMEMBER.COUNT,0)
   COUNT = COUNT + 1
END

ZS_MEMBER = 'N'
VERSION = 'N'

RETURN;

/******************************************************************/
COLLECT_DDLFILE_STATS:
/******************************************************************/

MEMBNAME = ""

DO FOREVER
   "LMMLIST DATAID(&MEMVAR) OPTION(LIST) MEMBER(MEMBNAME)"
   IF RC > 0 THEN LEAVE            /* END OF FILE                */

   X = 1
   Y = 1

   DO WHILE X < MEMB_C
      IF MEMBNAME = DDLMEMBER.X & COLLECT_GEBIET = 'N' THEN DO
         S = 0
         CALL READ_DDL_MEMB_DDLFILE
         X = X + 1
      END
      IF MEMBNAME = DDLMEMBER.X & COLLECT_GEBIET = 'Y' THEN DO
         DO WHILE Y < GEBIET_COUNT
            IF SUBSTR(DDLMEMBER.X,1,2) = GEBIET.Y THEN DO
               S = Y
               CALL READ_DDL_MEMB_DDLFILE
            END
         Y = Y + 1
         END
      END
   X = X + 1
   END
END
RETURN;


/******************************************************************/
READ_DDL_MEMB_DDLFILE:
/******************************************************************/

"LMMFIND DATAID(&MEMVAR) MEMBER("MEMBNAME")"

DO FOREVER
   "LMGET DATAID(&MEMVAR) MODE(INVAR) DATALOC(LINE)
          DATALEN(LINELEN) MAXLEN(160)"
   IF RC > 0 THEN LEAVE            /* END OF FILE                */

   PARSE UPPER VAR LINE V1 V2

   IF POS('CREATE',V2) > 0 & POS('DATABASE',V2) > 0 THEN DO
      CRE_DB_STAT.S = CRE_DB_STAT.S + 1
   END

   IF POS('CREATE',V2) > 0 & POS('TABLESPACE',V2) > 0 THEN DO
      CRE_TS_STAT.S = CRE_TS_STAT.S + 1
   END

   IF POS('CREATE',V2) > 0 & POS('TABLE',V2) > 0 &,
      POS('TABLESPACE',V2) = 0 THEN DO
      CRE_TBL_STAT.S = CRE_TBL_STAT.S + 1
   END

   IF POS('CREATE',V2) > 0 & POS('UNIQUE',V2) > 0 &,
      POS('INDEX',V2) > 0 THEN DO
      CRE_UIX_STAT.S = CRE_UIX_STAT.S + 1
   END

   IF POS('CREATE',V2) > 0 & POS('INDEX',V2) > 0 &,
      POS('UNIQUE',V2) = 0 THEN DO
      CRE_IX_STAT.S = CRE_IX_STAT.S + 1
   END

   IF POS('CREATE',V2) > 0 & POS('VIEW',V2) > 0 THEN DO
      CRE_VW_STAT.S = CRE_VW_STAT.S + 1
   END

   IF POS('CREATE',V2) > 0 & POS('TRIGGER',V2) > 0 THEN DO
      CRE_TR_STAT.S = CRE_TR_STAT.S + 1
   END

   IF POS('CREATE',V2) > 0 & POS('ALIAS',V2) > 0 THEN DO
      CRE_ALI_STAT.S = CRE_ALI_STAT.S + 1
   END

   IF POS('CREATE',V2) > 0 & POS('SYNONYM',V2) > 0 THEN DO
      CRE_SYN_STAT.S = CRE_SYN_STAT.S + 1
   END


   IF POS('ALTER',V2) > 0 & POS('ADMIN',V2) = 0,
      & POS('SET DATA TYPE',V2) = 0 THEN DO
      ALTER_STAT.S = ALTER_STAT.S + 1
   END

   IF POS('ADMIN',V2) > 0 & POS('DROP',V2) > 0 THEN DO
      ALTER_ADMIN_STAT.S = ALTER_ADMIN_STAT.S + 1
   END

   IF POS('ALTER',V2) > 0 & POS('SET DATA TYPE',V2) > 0 THEN DO
      ALTER_STAT.S = ALTER_STAT.S
   END


   IF POS('LABEL',V2) > 0 & POS('ON',V2) > 0 THEN DO
      LABEL_STAT.S = LABEL_STAT.S + 1
   END

   IF POS('COMMENT',V2) > 0 & POS('ON',V2) > 0 THEN DO
      COMMENT_STAT.S = COMMENT_STAT.S + 1
   END


   IF POS('DROP',V2) > 0 & POS('DATABASE',V2) > 0 THEN DO
      DROP_DB_STAT.S = DROP_DB_STAT.S + 1
   END

   IF POS('DROP',V2) > 0 & POS('TABLESPACE',V2) > 0 THEN DO
      DROP_TS_STAT.S = DROP_TS_STAT.S + 1
   END

   IF POS('DROP',V2) > 0 & POS('TABLE',V2) > 0 THEN DO
      DROP_TBL_STAT.S = DROP_TBL_STAT.S + 1
   END

   IF POS('DROP',V2) > 0 & POS('INDEX',V2) > 0 THEN DO
      DROP_IX_STAT.S = DROP_IX_STAT.S + 1
   END

   IF POS('DROP',V2) > 0 & POS('VIEW',V2) > 0 THEN DO
      DROP_VW_STAT.S = DROP_VW_STAT.S + 1
   END

   IF POS('DROP',V2) > 0 & POS('VW',V2) > 0 THEN DO
      DROP_VW_STAT.S = DROP_VW_STAT.S + 1
   END

   IF POS('DROP',V2) > 0 & POS('TRIGGER',V2) > 0 THEN DO
      DROP_TR_STAT.S = DROP_TR_STAT.S + 1
   END

   IF POS('DROP',V2) > 0 & POS('ALIAS',V2) > 0 THEN DO
      DROP_ALI_STAT.S = DROP_ALI_STAT.S + 1
   END

   IF POS('DROP',V2) > 0 & POS('SYNONYM',V2) > 0 THEN DO
      DROP_SYN_STAT.S = DROP_SYN_STAT.S + 1
   END

END
RETURN;

/******************************************************************/
COLLECT_WSLFILE_STATS:
/******************************************************************/

MEMBNAME = ' '              /* INITIALISE MEMBNAME */

DO FOREVER
   "LMMLIST DATAID(&MEMVAR) OPTION(LIST) MEMBER(MEMBNAME)"
   IF RC > 0 THEN LEAVE            /* END OF FILE                */

   X = 1
   Y = 1

   DO WHILE X < COUNT
      IF MEMBNAME = WSLMEMBER.X & COLLECT_GEBIET = 'N' THEN DO
         S = 0
         CALL READ_DDL_MEMB_WSLFILE
         X = X + 1
      END
      IF MEMBNAME = WSLMEMBER.X & COLLECT_GEBIET = 'Y' THEN DO
         DO WHILE Y < GEBIET_COUNT
            IF SUBSTR(WSLMEMBER.X,1,2) = GEBIET.Y THEN DO
               S = Y
               CALL READ_DDL_MEMB_WSLFILE
            END
         Y = Y + 1
         END
      END
   X = X + 1
   END
END
RETURN;

/******************************************************************/
READ_DDL_MEMB_WSLFILE:
/******************************************************************/

"LMMFIND DATAID(&MEMVAR) MEMBER("MEMBNAME")"

DO FOREVER
   "LMGET DATAID(&MEMVAR) MODE(INVAR) DATALOC(LINE)
          DATALEN(LINELEN) MAXLEN(80)"
   IF RC > 0 THEN LEAVE            /* END OF FILE                */

   PARSE UPPER VAR LINE V1

   IF POS('CREATE',V1) > 0 & POS('DATABASE',V1) > 0 THEN DO
      CRE_DB_STAT.S = CRE_DB_STAT.S + 1
   END

   IF POS('CREATE',V1) > 0 & POS('TABLESPACE',V1) > 0 THEN DO
      CRE_TS_STAT.S = CRE_TS_STAT.S + 1
   END

   IF POS('CREATE',V1) > 0 & POS('TABLE',V1) > 0 &,
      POS('TABLESPACE',V1) = 0 THEN DO
      CRE_TBL_STAT.S = CRE_TBL_STAT.S + 1
   END

   IF POS('CREATE',V1) > 0 & POS('UNIQUE',V1) > 0 &,
      POS('INDEX',V1) > 0 THEN DO
      CRE_UIX_STAT.S = CRE_UIX_STAT.S + 1
   END

   IF POS('CREATE',V1) > 0 & POS('INDEX',V1) > 0 &,
      POS('UNIQUE',V1) = 0 THEN DO
      CRE_IX_STAT.S = CRE_IX_STAT.S + 1
   END

   IF POS('CREATE',V1) > 0 & POS('VIEW',V1) > 0 THEN DO
      CRE_VW_STAT.S = CRE_VW_STAT.S + 1
   END

   IF POS('CREATE',V1) > 0 & POS('TRIGGER',V1) > 0 THEN DO
      CRE_TR_STAT.S = CRE_TR_STAT.S + 1
   END

   IF POS('CREATE',V1) > 0 & POS('ALIAS',V1) > 0 THEN DO
      CRE_ALI_STAT.S = CRE_ALI_STAT.S + 1
   END

   IF POS('CREATE',V1) > 0 & POS('SYNONYM',V1) > 0 THEN DO
      CRE_SYN_STAT.S = CRE_SYN_STAT.S + 1
   END


   IF POS('ALTER',V1) > 0 & POS('ADMIN',V1) = 0 THEN DO
      ALTER_STAT.S = ALTER_STAT.S + 1
   END

   IF POS('LABEL',V1) > 0 & POS('ON',V1) > 0 THEN DO
      LABEL_STAT.S = LABEL_STAT.S + 1
   END

   IF POS('COMMENT',V1) > 0 & POS('ON',V1) > 0 THEN DO
      COMMENT_STAT.S = COMMENT_STAT.S + 1
   END


   IF POS('DROP',V1) > 0 & POS('DATABASE',V1) > 0 THEN DO
      DROP_DB_STAT.S = DROP_DB_STAT.S + 1
   END

   IF POS('DROP',V1) > 0 & POS('TABLESPACE',V1) > 0 THEN DO
      DROP_TS_STAT.S = DROP_TS_STAT.S + 1
   END

   IF POS('DROP',V1) > 0 & POS('TABLE',V1) > 0 THEN DO
      DROP_TBL_STAT.S = DROP_TBL_STAT.S + 1
   END

   IF POS('DROP',V1) > 0 & POS('INDEX',V1) > 0 THEN DO
      DROP_IX_STAT.S = DROP_IX_STAT.S + 1
   END

   IF POS('DROP',V1) > 0 & POS('VIEW',V1) > 0 THEN DO
      DROP_VW_STAT.S = DROP_VW_STAT.S + 1
   END

   IF POS('DROP',V1) > 0 & POS('TRIGGER',V1) > 0 THEN DO
      DROP_TR_STAT.S = DROP_TR_STAT.S + 1
   END

   IF POS('DROP',V1) > 0 & POS('ALIAS',V1) > 0 THEN DO
      DROP_ALI_STAT.S = DROP_ALI_STAT.S + 1
   END

   IF POS('DROP',V1) > 0 & POS('SYNONYM',V1) > 0 THEN DO
      DROP_SYN_STAT.S = DROP_SYN_STAT.S + 1
   END

END
RETURN;

/******************************************************************/
OUTPUT_STATS:
/******************************************************************/

SAY ' '
SAY ' PRESS "ENTER" TO CONTINUE'
PULL

IF INTENTION = 'M' THEN DO
   ADDRESS DSNREXX "CONNECT "DBAF
           IF SQLCODE <> 0 THEN CALL SQLCA

   DELETE="DELETE FROM OA1A.TADM12A1                                ",
          " WHERE ZUEGELSCHUB = '"SEARCH_ZS"';                      "

   SQLTEXT = DELETE
   ADDRESS DSNREXX "EXECSQL DECLARE C2 CURSOR FOR S2"
   ADDRESS DSNREXX "EXECSQL PREPARE S2 FROM :DELETE"
   ADDRESS DSNREXX "EXECSQL EXECUTE S2"
   ADDRESS DSNREXX "EXECSQL COMMIT"
END

OUTPUT_COUNT = 0

DO WHILE OUTPUT_COUNT <= GEBIET_COUNT

ADDRESS TSO "CLEAR" /* BILDSCHIRM LÖSCHEN */


   TOTAL_CREATE.OUTPUT_COUNT = 0
   TOTAL_CREATE.OUTPUT_COUNT = CRE_DB_STAT.OUTPUT_COUNT,
                             + CRE_TS_STAT.OUTPUT_COUNT,
                             + CRE_TBL_STAT.OUTPUT_COUNT,
                             + CRE_IX_STAT.OUTPUT_COUNT,
                             + CRE_UIX_STAT.OUTPUT_COUNT,
                             + CRE_VW_STAT.OUTPUT_COUNT,
                             + CRE_TR_STAT.OUTPUT_COUNT,
                             + CRE_ALI_STAT.OUTPUT_COUNT,
                             + CRE_SYN_STAT.OUTPUT_COUNT

   TOTAL_ALTER.OUTPUT_COUNT = 0
   TOTAL_ALTER.OUTPUT_COUNT = ALTER_STAT.OUTPUT_COUNT,
                            + ALTER_ADMIN_STAT.OUTPUT_COUNT,
                            + COMMENT_STAT.OUTPUT_COUNT,
                            + LABEL_STAT.OUTPUT_COUNT

   TOTAL_DROP.OUTPUT_COUNT = 0
   TOTAL_DROP.OUTPUT_COUNT = DROP_DB_STAT.OUTPUT_COUNT,
                           + DROP_TS_STAT.OUTPUT_COUNT,
                           + DROP_TBL_STAT.OUTPUT_COUNT,
                           + DROP_IX_STAT.OUTPUT_COUNT,
                           + DROP_VW_STAT.OUTPUT_COUNT,
                           + DROP_TR_STAT.OUTPUT_COUNT,
                           + DROP_ALI_STAT.OUTPUT_COUNT,
                           + DROP_SYN_STAT.OUTPUT_COUNT

   FULL_TOTAL.OUTPUT_COUNT = 0
   FULL_TOTAL.OUTPUT_COUNT = TOTAL_CREATE.OUTPUT_COUNT,
                           + TOTAL_ALTER.OUTPUT_COUNT,
                           + TOTAL_DROP.OUTPUT_COUNT

   IF OUTPUT_COUNT = 0 THEN DO
      SAY ' G E S A M T   S T A T I S T I K  -' SEARCH_ZS
      SAY '    TOTAL AUFTRAEGE...........' CHANGE_REQUESTS.OUTPUT_COUNT
      SAY '    TOTAL COMPARES (V7.2 NEU).' COMP_NACHTRAEGE.OUTPUT_COUNT
      SAY '    TOTAL VERSIONS (V7.2 ALT).' VERS_NACHTRAEGE.OUTPUT_COUNT,
          '    NACHTRAEGE.' COMP_NACHTRAEGE.OUTPUT_COUNT +,
                            VERS_NACHTRAEGE.OUTPUT_COUNT -,
                            CHANGE_REQUESTS.OUTPUT_COUNT
      SAY ' '
   END

   IF OUTPUT_COUNT > 0 THEN DO
      IF SUBSTR(OUTPUT_APPLID.OUTPUT_COUNT,1,6) = 'OUTPUT' THEN DO
         OUTPUT_APPLID.OUTPUT_COUNT = 'NA'
         OUTPUT_APPLID_DESC.OUTPUT_COUNT = 'NA'
      END

      IF SHOWDETAILS = 'J' THEN DO
         SAY ' S T A T I S T I K   ' SEARCH_ZS,
             ' G E B I E T S P O I N T E R   ' GEBIET.OUTPUT_COUNT
         SAY ' A P P L - I D   ' OUTPUT_APPLID.OUTPUT_COUNT '-',
                                 OUTPUT_APPLID_DESC.OUTPUT_COUNT
         SAY ' '
      END
   END

   IF SHOWDETAILS = 'J' | OUTPUT_COUNT = 0 THEN DO

   SAY ' C R E A T E   D B 2   O B J E C T S'
   SAY '    TOTAL CREATE..........' TOTAL_CREATE.OUTPUT_COUNT
   SAY ' '
   SAY '    CREATE DATABASE.......' CRE_DB_STAT.OUTPUT_COUNT
   SAY '    CREATE TABLESPACE.....' CRE_TS_STAT.OUTPUT_COUNT
   SAY '    CREATE TABLE..........' CRE_TBL_STAT.OUTPUT_COUNT
   SAY '    CREATE INDEX..........' CRE_IX_STAT.OUTPUT_COUNT
   SAY '    CREATE UNIQUE INDEX...' CRE_UIX_STAT.OUTPUT_COUNT
   SAY '    CREATE VIEW...........' CRE_VW_STAT.OUTPUT_COUNT
   SAY '    CREATE TRIGGER........' CRE_TR_STAT.OUTPUT_COUNT
   SAY '    CREATE ALIAS..........' CRE_ALI_STAT.OUTPUT_COUNT
   SAY '    CREATE SYNONYM........' CRE_SYN_STAT.OUTPUT_COUNT
   SAY ' '
   SAY ' A L T E R   D B 2   O B J E C T S'
   SAY '    TOTAL ALTER...........' TOTAL_ALTER.OUTPUT_COUNT
   SAY ' '
   SAY '    DIVERSE ALTER.........' ALTER_STAT.OUTPUT_COUNT
   SAY '    ADMIN ALTER (=DROP)...' ALTER_ADMIN_STAT.OUTPUT_COUNT
   SAY '    COMMENT ON............' COMMENT_STAT.OUTPUT_COUNT
   SAY '    LABEL ON..............' LABEL_STAT.OUTPUT_COUNT
   SAY ' '
   SAY ' D R O P   D B 2   O B J E C T S'
   SAY '    TOTAL DROP............' TOTAL_DROP.OUTPUT_COUNT
   SAY ' '
   SAY '    DROP DATABASE.........' DROP_DB_STAT.OUTPUT_COUNT
   SAY '    DROP TABLESPACE.......' DROP_TS_STAT.OUTPUT_COUNT
   SAY '    DROP TABLE............' DROP_TBL_STAT.OUTPUT_COUNT
   SAY '    DROP INDEX............' DROP_IX_STAT.OUTPUT_COUNT
   SAY '    DROP VIEW.............' DROP_VW_STAT.OUTPUT_COUNT
   SAY '    DROP TRIGGER..........' DROP_TR_STAT.OUTPUT_COUNT
   SAY '    DROP ALIAS............' DROP_ALI_STAT.OUTPUT_COUNT
   SAY '    DROP SYNONYM..........' DROP_SYN_STAT.OUTPUT_COUNT
   SAY ' ===================================='
   SAY '    TOTAL CHANGED.........' FULL_TOTAL.OUTPUT_COUNT

   IF OUTPUT_COUNT = 0 THEN DO
      SAY ' '
      SAY ' PRESS "ENTER" TO CONTINUE'
      PULL
   END

   END


   IF OUTPUT_COUNT > 0 THEN DO

      ADDRESS DSNREXX "CONNECT "DBAF
              IF SQLCODE <> 0 THEN CALL SQLCA

      INSERT= "INSERT INTO OA1A.TADM12A1 ( "              ,
              "ZUEGELSCHUB             ,"                 ,
              "CHANGE_REQ              ,"                 ,
              "COMPARES                ,"                 ,
              "VERSIONS                ,"                 ,
              "GEBIETSPOINTER          ,"                 ,
              "APPLID                  ,"                 ,
              "APPLID_DESC             ,"                 ,
              "CREATE_TOTAL            ,"                 ,
              "CREATE_DB               ,"                 ,
              "CREATE_TS               ,"                 ,
              "CREATE_TBL              ,"                 ,
              "CREATE_IX               ,"                 ,
              "CREATE_UNIQUE_IX        ,"                 ,
              "CREATE_VIEW             ,"                 ,
              "CREATE_TRIGGER          ,"                 ,
              "CREATE_ALIAS            ,"                 ,
              "CREATE_SYNONYM          ,"                 ,
              "ALTER_TOTAL             ,"                 ,
              "ALTER_DIVERSE           ,"                 ,
              "ALTER_ADMIN_DROP        ,"                 ,
              "ALTER_COMMENT           ,"                 ,
              "ALTER_LABEL             ,"                 ,
              "DROP_TOTAL              ,"                 ,
              "DROP_DB                 ,"                 ,
              "DROP_TS                 ,"                 ,
              "DROP_TBL                ,"                 ,
              "DROP_INDEX              ,"                 ,
              "DROP_VIEW               ,"                 ,
              "DROP_TRIGGER            ,"                 ,
              "DROP_ALIAS              ,"                 ,
              "DROP_SYNONYM            ,"                 ,
              "TOTAL_CHANGED           )"                 ,
              "VALUES ('"SEARCH_ZS"'    "                 ,
              "       ,"CHANGE_REQUESTS.OUTPUT_COUNT      ,
              "       ,"COMP_NACHTRAEGE.OUTPUT_COUNT      ,
              "       ,"VERS_NACHTRAEGE.OUTPUT_COUNT      ,
              "       ,'"GEBIET.OUTPUT_COUNT"'"           ,
              "       ,'"OUTPUT_APPLID.OUTPUT_COUNT"'"    ,
              "       ,'"OUTPUT_APPLID_DESC.OUTPUT_COUNT"'",
              "       ,"TOTAL_CREATE.OUTPUT_COUNT         ,
              "       ,"CRE_DB_STAT.OUTPUT_COUNT          ,
              "       ,"CRE_TS_STAT.OUTPUT_COUNT          ,
              "       ,"CRE_TBL_STAT.OUTPUT_COUNT         ,
              "       ,"CRE_IX_STAT.OUTPUT_COUNT          ,
              "       ,"CRE_UIX_STAT.OUTPUT_COUNT         ,
              "       ,"CRE_VW_STAT.OUTPUT_COUNT          ,
              "       ,"CRE_TR_STAT.OUTPUT_COUNT          ,
              "       ,"CRE_ALI_STAT.OUTPUT_COUNT         ,
              "       ,"CRE_SYN_STAT.OUTPUT_COUNT         ,
              "       ,"TOTAL_ALTER.OUTPUT_COUNT          ,
              "       ,"ALTER_STAT.OUTPUT_COUNT           ,
              "       ,"ALTER_ADMIN_STAT.OUTPUT_COUNT     ,
              "       ,"COMMENT_STAT.OUTPUT_COUNT         ,
              "       ,"LABEL_STAT.OUTPUT_COUNT           ,
              "       ,"TOTAL_DROP.OUTPUT_COUNT           ,
              "       ,"DROP_DB_STAT.OUTPUT_COUNT         ,
              "       ,"DROP_TS_STAT.OUTPUT_COUNT         ,
              "       ,"DROP_TBL_STAT.OUTPUT_COUNT        ,
              "       ,"DROP_IX_STAT.OUTPUT_COUNT         ,
              "       ,"DROP_VW_STAT.OUTPUT_COUNT         ,
              "       ,"DROP_TR_STAT.OUTPUT_COUNT         ,
              "       ,"DROP_ALI_STAT.OUTPUT_COUNT        ,
              "       ,"DROP_SYN_STAT.OUTPUT_COUNT        ,
              "       ,"FULL_TOTAL.OUTPUT_COUNT           ,
              "       )"
       SQLTEXT = INSERT
       ADDRESS DSNREXX "EXECSQL DECLARE C1 CURSOR FOR S1"
       IF SQLCODE <> 0 THEN CALL SQLCA
       ADDRESS DSNREXX "EXECSQL PREPARE S1 FROM :INSERT"
       IF SQLCODE <> 0 THEN CALL SQLCA
       ADDRESS DSNREXX "EXECSQL EXECUTE S1"
       IF SQLCODE <> 0 THEN CALL SQLCA

       IF OUTPUT_COUNT > 0 & SHOWDETAILS = 'J' THEN DO
          SAY ' '
          SAY 'ZÜGELSCHUB STATISTIKEN FÜR >>> 'GEBIET.OUTPUT_COUNT ' <<<',
              'INSERTED IN TO TABLE TADM12A1|'

          SAY ' '
          SAY ' PRESS "ENTER" TO CONTINUE'
          PULL
       END

   END

   OUTPUT_COUNT = OUTPUT_COUNT + 1

END
RETURN;


/******************************************************************/
SQLCA:
/******************************************************************/
SAY 'SQLCODE =' SQLCODE
SAY 'SQLERRMC=' SQLERRMC
SAY 'SQLERRP =' SQLERRP
SAY 'SQLERRD =' SQLERRD.1',',
                SQLERRD.2',',
                SQLERRD.3',',
                SQLERRD.4',',
                SQLERRD.5',',
                SQLERRD.6
SAY 'WQLWARN='  SQLWARN.0',',
                SQLWARN.1',',
                SQLWARN.2',',
                SQLWARN.3',',
                SQLWARN.4',',
                SQLWARN.5',',
                SQLWARN.6',',
                SQLWARN.7',',
                SQLWARN.8',',
                SQLWARN.9',',
                SQLWARN.10
SAY 'SQLSTATE=' SQLSTATE
SAY 'SQLTEXT =' SQLTEXT
EXIT
RETURN;
----- zSta2 zwischen version|||---------------------------------------*/
call errReset 'hi'
aufLst = 'dsn.dbx.zgl(zstaMbr) ::f'
if 0 then
    exit checkAuftrag('dsn.dbx.auftrag', 20130507  20130512, aufLst)
dsnPre = 'DSN.DBX'

m.mm.verbs = '   CREATE     ALTER      DROP     '
m.mm.verb2 = m.mm.verbs 'REBIND'
m.mm.objs = 'DATABASE TABLESPACE TABLE INDEX VIEW TRIGGER SYNONYM ALIAS'
m.mm.obj2 = m.mm.objs 'UNIQUE'
m.mm.auft = ''
m.mm.count.auft = 0
m.mm.count.list = 0
m.mm.count.nact = 0
m.mm.count.rebind = 0
m.mm.count.load = 0
m.nachtragChars = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'
       /* PromotionPaths */
m.iProm.1 = 'ET IT PQ PA PR'
m.iProm.2 = 'RZ1/DBAF,RZ8/DC0G RZ1/DBTF,RZ8/DD0G,RZZ/DE0G' ,
                    'RQ2/DBOF,RR2/DBOF RR2/DBOF RZ2/DBOF'
m.iProm.3 = 'RZ8/DCVG RZ1/DVTB,RZ8/DDVG,RZZ/DEVG' ,
                    'RQ2/DVBP,RR2/DVBP RR2/DVBP RZ2/DVBP'
m.iProm.0 = 3
call readDsn aufLst, m.l.
do lx=1 to m.l.0
    au = word(m.l.lx, 1)
    a7 = left(translate(au), 7)
    if abbrev(a7, '*') | a7 = '' then
        iterate
    m.auft.a7 = au word(m.l.lx, 2)
    m.mm.auft = m.mm.auft a7
    m.mm.count.list = m.mm.count.list + 1
    end
dbSys = ''
rz = sysvar(sysNode)
do px=1 to m.iProm.0
    p1 = translate(m.iProm.px, ' ', ',')
    pc = pos(rz'/', p1)
    do while pc > 0
        ps = word(substr(p1, pc+4), 1)
        if wordPos(ps, dbSys) < 1 then
            dbSys = strip(dbSys ps)
        pc = pos(rz'/', p1,  pc+4)
        end
    end
say 'statistics for' dbSys
do ox=1 to words(m.mm.obj2)
    o1 = word(m.mm.obj2, ox)
    do vx=1 to words(m.mm.verbs)
        v1 = word(m.mm.verbs, vx)
        m.mm.count.o1.v1 = 0
        end
    end

do dx=1 to words(dbSys)
    d1 = word(dbSys, dx)
    ana = dsnPre || d1'.ANA'
    if sysDsn("'"ana"'") <> 'OK' then do
        say '---' d1 'sysDsn('ana')' sysDsn("'"ana"'")
        iterate
        end
    say '---' d1
    lmm = lmmBegin(ana)
    laMbr = ''
    do forever
        m1 = lmmNext(lmm)
        if m1 == '' then
            leave
        m7 = left(m1, 7)
        if symbol('m.auft.m7') \== 'VAR' then
             iterate
        if left(m1, 7) <> left(laMbr, 7) then
            call countNachtrag mm, laMbr
        laMbr = m1
        say '---'m1 m.auft.m7
        call countSqls mm, ana'('m1')'
        end
    call countNachtrag mm, laMbr
    end
call adrTso 'clear'
total = '--total--'
say 'Zuegelschub Statistik fuer' dbSys 'in' rz
say left('Auftraege in Liste', 19) right(m.mm.count.list, 9)
say left('Auftraege analys''t', 19) right(m.mm.count.auft, 9)
say left('Nachtraege', 19) right(m.mm.count.nact - m.mm.count.auft, 9)
say left('Load', 19) right(m.mm.count.load, 9)
say left('Rebind Package', 19) right(m.mm.count.rebind, 9)
say ''
say left('',19) m.mm.verbs
do vx=1 to words(m.mm.verbs)
    v1 = word(m.mm.verbs, vx)
    m.mm.count.total.v1 = 0
    m.mm.count.index.v1 = m.mm.count.index.v1 + m.mm.count.unique.v1
    end
obj3 = m.mm.objs total
do ox=1 to words(obj3)
    o1 = word(obj3, ox)
    t = left(o1, 19)
    do vx=1 to words(m.mm.verbs)
        v1 = word(m.mm.verbs, vx)
        t = t right(m.mm.count.o1.v1, 9)
        m.mm.count.total.v1 = m.mm.count.total.v1 + m.mm.count.o1.v1
        end
    say t
    end
say words(m.mm.auft) 'auftraege in list but not in ana' m.mm.auft
exit

checkAuftrag: procedure expose m.
parse arg lib, von bis, aufLst
    ox = 0
    if bis == '' then
        bis = von
    lmm = lmmBegin(lib)
    ls = 0
    z0 = 0
    do mx=1
        m1 = lmmNext(lmm)
        if m1 == '' then
            leave
        call readDsn lib'('m1')', 'M.I.'
        ls = ls + m.i.0
        if mx // 100 = 0 then
            say mx m1 'z0='z0 'lines='ls
        if translate(word(m.i.2, 1)) \== 'ZUEGELSCHUB' then do
            z0 = z0 + 1
            iterate
            end
        z1 = word(m.i.2, 2)
        if z1 << von | z1 >> bis then
            iterate
        do ax=m.i.0 by -1 to 2 while translate(word(m.i.ax, 1)) ,
                     \== 'COMPARE'
            end
        ac = if(ax>2, word(m.i.ax, 2))
        ox = ox + 1
        m.o.ox = m1 ac
        end
    say (mx-1) 'members' m1
    call writeDsn aufLst, m.o., ox, 1
    return 0
endProcedure checkAuftrag

countNachtrag: procedure expose m.
parse arg m, mbr
    if mbr == '' then
        return
    nx = pos(substr(mbr, 8, 1), m.nachtragChars)
    if length(mbr) <> 8 | nx < 1 then
        call err 'bad member' mbr
    m.m.count.auft = m.m.count.auft + 1
    m.m.count.nact = m.m.count.nact + nx
    a7 = left(mbr, 7)
    wx = wordPos(a7, m.m.auft)
    if wx > 0 then
        m.m.auft = subword(m.m.auft, 1, wx-1) subword(m.m.auft, wx+1)
    else
        say a7 mbr 'not in list'
    return
endProcedcure countNachtrag

countSqls: procedure expose m.
parse arg m, dsn
    call readNxBegin nx, dsn
    do lx=1
        lp = readNx(nx)
        if lp == '' then
            leave
        li = translate(strip(m.lp))
        if li == '' | abbrev(li, '--') then
            iterate
        if abbrev(li, '.') then do
             if abbrev(li, '.CALL SNAPSHOT') then do
                 sx = lx
                 do until lp == '' | abbrev(m.lp, '.ENDDATA')
                     lx = lx + 1
                     lp = readNx(nx)
                     end
                   if lx - sx > 200 then
                       say '???snapshot' sx'-'lx 'tooLong'
                 end
             else if abbrev(li, '.CALL UTIL LOAD ') then do
                 m.m.count.load = m.m.count.load + 1
                 end
             iterate
             end
        if wordPos(word(li, 1), m.m.verb2) < 1 then
            iterate
        v = word(li, 1)
        if v = 'REBIND' then do
            m.m.count.rebind = m.m.count.rebind ,
                + (pos('PACKAGE', li) > 0)
            iterate
            end
        ox = wordPos(word(li, 2), m.m.obj2)
        if ox < 1 & (v == 'DROP' | v == 'ALTER') then
            iterate
        do wx=3 to min(5, words(li)) while ox < 1
            ox = wordPos(word(li, wx), m.m.obj2)
            end
        if ox < 1 then
            call err 'no object' m.m.obj2 'in' lx':'li
        o = word(m.m.obj2, ox)
        if 0 then
            say v o lx':' strip(li, 't')
        if \ datatype(m.m.count.o.v, 'n') ,
         | wordPos(v, m.m.verbs) < 0 then
            say '???' v o '???' li
        m.m.count.o.v = m.m.count.o.v + 1
        end
    call readNxEnd nx
    return
endProcedure countSqls

/* 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 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 expose m.
    parse arg grp
    call readDDEnd 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   *************************************************/
/* copy adrTso begin *************************************************/
/*--- send ggTsoCmd to tso, fail if rc <> 0 or not listed in ggRet ---*/
adrTso:
    parse arg ggTsoCmd, ggRet
    address tso ggTsoCmd
    if rc == 0                     then return 0
    else if ggRet == '*'           then return rc
    else if wordPos(rc, ggRet) > 0 then return rc
    else
        call err 'adrTso rc' rc 'for' ggTsoCmd
return /* end adrTso */

/*--- format dsn from tso format to jcl format -----------------------*/
dsn2jcl: procedure expose m.
parse upper arg dsn ., addPrefix
    if left(dsn,1) = "'" then
        return strip(dsn, 'b', "'")
    sp = sysvar('SYSPREF')
    if sp == '' then
        sp = userid()
    cx = pos('~', dsn)
    if cx < 1 & addPrefix == 1 then
        return sp'.'dsn
    do while cx \== 0
        le = left(dsn, cx-1)
        ri = substr(dsn, cx+1)
        if right(le, 1) == '.' | left(ri, 1) == '.' then
            dsn = le || sp || ri
        else
            dsn = le || left('.', le \== '') || sp ,
                     || left('.', ri \== '') || ri
        cx = pos('~', spec, cx)
        end
    return dsn
endProcedure dsn2Jcl

/*--- format dsn from jcl format to tso format -----------------------*/
jcl2dsn: procedure expose m.
parse arg dsn .
    return "'"dsn"'"
endProcedure jcl2dsn

dsnSetMbr: procedure expose m.
parse arg dsn, mbr
     bx = pos('(', dsn)
     if bx > 0 then
         dsn = strip(left(dsn, bx-1))
     if mbr <> '' then
         dsn = dsn'('strip(mbr)')'
     return dsn
endProcedure dsnSetMbr

dsnGetMbr: procedure expose m.
parse arg dsn
     lx = pos('(', dsn)
     rx = pos(')', dsn, lx+1)
     if lx < 1 then
         return ''
     else if lx < rx then
         return substr(dsn, lx+1, rx-lx-1)
     else
         return strip(substr(dsn,lx+1))
endProcedure dsnGetMbr
/**********************************************************************
    io: read or write a dataset with the following callsequences:
        read:  readDDBegin, readDD*,  readDDEnd
        write: writeBegin,  writeDD*, writeEnd

        readDD returns true if data read, false at eof
***********************************************************************/

/*--- prepare reading from a DD --------------------------------------*/
readDDBegin: procedure expose m.
    parse upper arg ggDD
    call errAddCleanup 'call readDDEnd' ggDD', "*"'
return /* end readDDBegin */

/*--- read from DD ggDD into ggSt, return false at eof ---------------*/
readDD:
    parse arg ggDD, ggSt, ggCnt
    if ggCnt = '' then
        ggCnt = 100
    call adrTso 'execio' ggCnt 'diskr' ggDD '(stem' ggSt')', 2
    return (value(ggSt'0') > 0)
return /* end readDD */

/*--- finish reading DD  ggDD ----------------------------------------*/
readDDEnd: procedure expose m.
    parse upper arg ggDD, ggRet
    call errRmCleanup 'call readDDEnd' ggDD', "*"'
    return adrTso('execio 0 diskr' ggDD '(finis)', ggRet)
endProcedure readDDEnd

/*--- prepare writing to DD ggDD -------------------------------------*/
writeDDBegin: procedure expose m.
    parse upper arg ggDD
                  /* ensure file is erased, if no records are written */
    call adrTso 'execio' 0 'diskw' ggDD '(open)'
    call errAddCleanup 'call writeDDEnd' ggDD', "*"'
return /* end writeDDBegin */

/*--- write to gg ggDD from stem ggSt, ggCnt records -----------------*/
writeDD:
    parse arg ggDD, ggSt, ggCnt
    if ggCnt == '' then
        ggCnt = value(ggst'0')
    call adrTso 'execio' ggCnt 'diskw' ggDD '(stem' ggSt')'
    return
endSubroutine writeDD

/*--- end writing to dd ggDD (close) --------------------------------*/
writeDDEnd: procedure expose m.
parse upper arg ggDD, ggRet
    call errRmCleanup 'call writeDDEnd' ggDD', "*"'
    return adrTso('execio 0 diskw' ggDD '(finis)', ggRet)
endProcedure writeDDEnd

/*--- readNx: read next line, using buffer ---------------------------*/
/*--- begin: allocate dsnSpec and ini ------------------------ -------*/
readNxBegin: procedure expose m.
    parse arg m, m.m.dsn, m.m.dd, m.m.Cnt
    if m.m.dd = '' then
        m.m.dd = tsoDD('DDNX*')
    if m.m.cnt = '' then
        m.m.cnt = 1000
    m.m.cx = m.m.cnt + 999
    m.m.buf0x = 0
    m.m.0 = 0
    m.m.free = subword(dsnAlloc('dd('m.m.dd')' m.m.dsn), 2)
    call readDDBegin m.m.dd
    return m
endProcedure readDDNxBegin

/*--- return the stem of the next line, or '' at end -----------------*/
readNx: procedure expose m.
parse arg m
    m.m.cx = m.m.cx + 1
    if m.m.cx <= m.m.0 then
        return m'.'m.m.cx
    m.m.buf0x = m.m.buf0x + m.m.0
    if \ readDD(m.m.dd, 'M.'m'.', m.m.cnt)then
        return ''
    m.m.cx = 1
    return m'.1'
endProcedure readDDNx
/*--- return the stem of the curr line, '' at end --------------------*/
readNxCur: procedure expose m.
parse arg m
    if m.m.cx <= m.m.0 then
        return m'.'m.m.cx
    else
        return ''
endProcedure readNxCur

/*--- return the position (line number) of reader
           plus le characters of the current line (default 50) ------*/
readnxPos: procedure expose m.
parse arg m, le
    li = m'.'m.m.cx
    li = strip(m.li, 't')
    if arg() < 2 then
        le = 50
    if le < 1 then
        li = ''
    else if length(li) <= le then
        li = ':' li
    else
        li = ':' left(li, le-3)'...'
    return 'line' (m.m.buf0x + m.m.cx)li
endProcedure readnxPos

/*--- close and deallocate ------------------------------------------*/
readNxEnd: procedure expose m.
parse arg m
    call readDDEnd m.m.dd
    interpret m.m.free
    return
endProcedure readDDNxEnd

/*--- standardise a dsn spec
       word1             dsName or -
       word2             dd     or -
       word3             disp   or -
       word4 to first :  attributes in tso format
       after first :     attributes for new allocation
----------------------------------------------------------------------*/
dsnSpec: procedure expose m.
parse upper arg spec
    rr = ''      /* put leading - in separate words */
    do sx=1 while words(rr) < 3 & wx \= ''
        wx = word(spec, sx)
        do while abbrev(wx, '-') & words(rr) < 3
            wx = substr(wx, 2)
            rr = rr '-'
            end
        rr = rr wx
        end
    spec = rr subWord(spec, sx)
    na = ''
    dd = ''
    di = ''
    if left(spec, 1) = '&' then /* external spec is handled ok */
        spec = strip(substr(spec, 2))
    do wx=1 by 1
        w = word(spec, wx)
        if w = '' | abbrev(w, '.') | abbrev(w, ':') then
            leave
        else if wordPos(w, 'OLD SHR MOD NEW')>0 | abbrev(w, 'SYSO') then
            di = w
        else if w = 'CATALOG' then
            di = di w
        else if abbrev(w, 'DD(') then
            dd = substr(w, 4, length(w)-4)
        else if abbrev(w, 'DSN(') then
            na = strip(substr(w, 5, length(w)-5))
        else if na == '' then
            na = dsn2jcl(w)
        else if dd == '' then
            dd = w
        else if di == '' then
            di = w
        else
            leave
        end
    if na == '' then
        na = '-'
    else if abbrev(na, "'") then
        na = substr(na, 2, length(na)-2)
    if dd == '' then dd = '-'
    if di == '' then di = '-'
    re = subword(spec, wx)
    if abbrev(re, '.') then
        re = substr(re, 2)
    return na dd di re
endProcedure dsnSpec

/*--- alloc a dsn with dsnAlloc
          if the dsn is inuse wait and retry
          until either the allocation is successfull
          or the timeout occurs --------------------------------------*/
dsnAllocWait: procedure expose m.
parse upper arg spec, pDi, pDD, timeOut
    x = max(1, arg() - 1)
    do rt=0
        m.adrTsoAl.1 = ''
        m.adrTsoAl.2 = ''
        m.adrTsoAl.3 = ''
        call outtrap m.adrTsoAl.
        res = dsnAlloc(spec, pDi, pDD, '*')
        call outtrap off
        if \ abbrev(res, ' ') then
            return res
        msg = m.adrTsoAl.1'\n'm.adrTsoAl.2'\n'm.adrTsoAl.3
        if rt > timeOut & timeOut \== '' then
            return err('timeout allocating' spec time() '\n'msg)
        if pos('DATA SET IS ALLOCATED TO ANOTHER', msg) < 1 then
            return err('allocating' spec'\n'msg)
        say time() 'sleep and retry alloc' spec
        call sleep 1, 0
        end
endProcedure dsnAllocWait

/*--- alloc a dsn or a dd
          spec '-'<ddName>
               datasetName? disposition? '.'? attributes? (':' newAtts)?
          disp default disposition
          dd   default dd name
          retRc   erlaubte ReturnCodes (leer = 0)
          returns if ok then ddName <rexx for free> otherwise rc -----*/
dsnAlloc: procedure expose m.
parse upper arg spec, pDi, pDD, retRc
    parse value dsnSpec(spec) with na dd di rest
    if na = '-' then
        m.dsnAlloc.dsn = ''
    else
        m.dsnAlloc.dsn = na
    if na == '-' & dd \== '-' & di == '-' & rest = '' then
        return dd
    if dd == '-' & pDD \== '' then
        dd = pDD
    if dd == '-' then
        dd = 'DD*'
    dd = tsoDD(dd, '+')
    if di = '-' & pDi \== '' then
        di = pDi
    if di = '-' then
        di = 'SHR'
    else if pos('(', na) < 1 then
        nop
    else if di = 'MOD' then
        call err 'disp mod for' na
    else
        di = 'SHR'
    if pos('/', na) > 0 then
        return csmAlloc(na dd di rest, retRc)
    else
        return tsoAlloc(na dd di rest, retRc)
endProcedure dsnAlloc

/*--- find a free dd with prefix dd ----------------------------------*/
tsoDD: procedure expose m.
parse arg dd, f
    if m.err.ispf then
        address ispExec 'vget wshTsoDD shared'
    else if symbol('m.tso.tsoDD') == 'VAR' then
        wshTsoDD = m.tso.tsoDD
    else
        wshTsoDD = ''
    if f == '-' then do
        px = wordPos(dd, wshTsoDD)
        if px < 1 then
            call err 'tsoDD dd' dd 'not used' wshTsoDD
        wshTsoDD = strip(subword(wshTsoDD, 1, px-1) ,
                         subWord(wshTsoDD, px+1))
        end
    else do
        if right(dd, 1) = '*' then do
            dd = left(dd, length(dd)-1) || m.err.screen
            cx = lastPos(' 'dd, ' 'wshTsoDD)
            if cx < 1 then
                dd = dd'1'
            else do
                old = word(substr(wshTsoDD, cx), 1)
                if datatype(substr(old, length(dd)+1), 'n') then
                    dd = dd || (substr(old, length(dd)+1) + 1)
                else
                    call err 'tsoDD old' old 'suffix not numeric dd' dd
                end
            end
        if wordPos(dd, wshTsoDD) > 0 then
            call err 'tsoDD dd' dd 'already used' wshTsoDD
        if f == '+' then
            wshTsoDD = strip(wshTsoDD dd)
        end
    if m.err.ispf then
        address ispExec 'vPut wshTsoDD shared'
    m.tso.tsoDD = wshTsoDD
    return dd
endProcedure tsoDD

tsoAlloc: procedure expose m.
parse arg na dd disp rest ':' nn, retRc
    c = 'alloc dd('dd')' disp
    if na \== '-' then
        c = c "DSN('"na"')"
    else if disp = 'NEW' and nn \== '' then
        c = c dsnCreateAtts(,nn)
    call outtrap m.adrTsoAl.
    alRc = adrTso(c rest, '*')
    call outtrap off
    if alRc =  0 then do
        call errAddCleanup 'call tsoFree' dd', "*"'
        return dd 'call tsoFree' dd';'
        end
    if nn \= '' & wordPos(disp, 'OLD SHR') > 0 ,
          & sysDsn("'"m.dsnAlloc.dsn"'") == 'DATASET NOT FOUND' then do
        say 'tsoAlloc creating' c rest ':'nn
        call adrTso 'alloc dd('dd') new catalog' dsnCreateAtts(na, nn)
        call adrTso 'free  dd('dd')'
        return tsoAlloc(na dd disp rest, retRc)
        end
    do ax=1 to m.adrTsoAl.0
        say m.adrTsoal.ax
        end
    if retRc = '*' | wordPos(alRc, retRc) > 0 then
        return ' ' alRc
    call err 'tsoAlloc rc' alRc 'for' c rest
endProcedure tsoAlloc

tsoAtts: procedure expose m.
parse arg dsn
    rc = listDsi("'"dsn"' SMSINFO")
    if rc = 0 then
        mv = ''
    else if rc = 4 & sysReason = 19 then do
        mv = 'UNITCNT(30)'
        say 'multi volume' mv
        end
    else if rc ^= 0 then
        call err 'listDsi rc' rc 'reason' sysReason,
                             sysMsgLvl1 sysMsgLvl2
    al = 'CAT'
    al = ''
    if right(sysDsSms, 7) == 'LIBRARY' ,
        | abbrev(sysDsSms, 'PDS') then
         al = al 'DSNTYPE(LIBRARY)'
    if sysUnits = 'TRACK' then
        sysUnits = 'TRACKS'
    return al "DSORG("sysDSorg") MGMTCLAS("sysMgmtClass")",
        "DATACLAS("sysDataClass")" ,
        "RECFM("translate('1 2 3', ' 'sysREcFM, ' 123')")",
        "LRECL("SYSLRECL")",
        "SPACE("sysPrimary"," sysSeconds")" sysUnits mv
    /*  "blksize("sysBLkSIZE")" removed 3.4.13: let sms do the magic */
endProcedure tsoAtts

tsoFree: procedure expose m.
parse arg dd, ggRet
    call adrTso 'free dd('dd')', ggRet
    call tsoDD dd, '-'
    call errRmCleanup 'call tsoFree' dd', "*"'
    return
endProcedure tsoFree

dsnCreateAtts: procedure expose m.
parse arg dsn, atts, forCsm
    forCsm = forCsm == 1
    aU = ' 'translate(atts)
    res = ''
    if dsn \== '' then
        res = "dataset('"dsnSetMbr(dsn)"')"
    if abbrev(atts, '~') then
        return res tsoAtts(substr(atts, 2))
    if abbrev(atts, ':') then do
        parse var atts a1 atts
        rl = substr(a1, 3)
        if abbrev(a1, ':F') then do
            if rl = '' then
                rl = 80
            recfm='f b'
            end
        else do
            if rl = '' then
                rl = 32756
            recfm = substr(a1, 2, 1) 'b'
            end
        res =  res "recfm("space(recfm, 1-forCsm)") lrecl("rl")"
        end
    if pos('(', dsn) > 0 & pos(' DSNTYPE(', aU) < 1 ,
                         & pos(' DSORG(',   aU) < 1 then
        res = res 'dsntype(library) dsorg(po)'
    if pos(' MGMTCLAS(', aU) < 1 then
        res = res 'mgmtclas(COM#A091)'
    if pos(' SPACE(', aU) < 1 then
        res = res 'space(10, 1000) cyl' || copies('inder', forCsm)
    return res atts
endProcedure dsnCreateAtts
/*--- check if a dataset is archive ------------------------------------
          returns 'ok'                    if dataset on disk
                  'not'                   if dataset is not catalogued
                  'arc'                   if dataset archived
                  listDsi errorMsg        otherwise ------------------*/
dsnArc: procedure expose m.
parse upper arg dsn
    lc = listDsi("'"strip(dsn)"' noRecall")
    if lc = 0 then
        return 'ok'
    else if lc=4 & sysReason = 19 then  /* multiple volumes */
        return 'ok'
    else if lc=16 & sysReason = 5 then
        return 'notCat'
    else if lc=16 & sysReason = 9 then
        return 'arc'
    else
        return 'listDsi cc='lc', sysReason='sysReason ,
                          'm2='sysMsgLvl2', m1='sysMsgLvl1
endProcedure dsnArc
/*--- read the dataset specified in ggDsnSpec to stem ggSt -----------*/
readDSN:
parse arg ggDsnSpec, ggSt
    ggAlloc = dsnAlloc(ggDsnSpec, 'SHR', 'readDsN')
    call adrTso 'execio * diskr' word(ggAlloc, 1) '(stem' ggSt' finis)'
    interpret subword(ggAlloc, 2)
    return
endSubroutine readDsn

/*--- write the dataset specified in ggDsnSpec from stem ggSt
          write ggCnt records if not empty otherwise ggst0
          if ggSay 1 then say ... records written to ... -------------*/
writeDSN:
parse arg ggDsnSpec, ggSt, ggCnt, ggSay
    if ggCnt == '' then
        ggCnt = value(ggst'0')
    ggAlloc = dsnAlloc(ggDsnSpec, 'OLD', 'readDsN')
    call adrTso 'execio' ggCnt 'diskw' word(ggAlloc, 1) ,
            '(stem' ggSt 'open finis)'
    interpret subword(ggAlloc, 2)
    if ggSay == 1 | m.debug == 1 then
       say ggCnt 'records written to' ggDsnSpec
    return
endSubroutine writeDsn

copyDSN: procedure expose m.
parse arg frSpec, toSpec, ggSay
    frDD = dsnAlloc(frSpec, 'SHR', 'FRDD')
    toDD = dsnAlloc(toSpec, 'OLD', 'TODD')
    call readDDBegin word(frDD, 1)
    call writeDDBegin word(toDD, 1)
    cnt = 0
    do while readDD(word(frDD, 1), r.)
        call writeDD word(toDD, 1), r.
        cnt = cnt + r.0
        end
    call readDDEnd word(frDD, 1)
    call writeDDEnd word(toDD, 1)
    interpret ';' subword(frDD, 2) '; ; ;' subword(toDD, 2)
    if ggSay == 1 | m.debug == 1 then
       say cnt 'records copied from' frSpec 'to' to toSpec
    return
endSubroutine writeDsn
/* copy adrTso end ****************************************************/
/* copy err begin *** errorhandling, messages, help    ****************/
errIni: procedure expose m.
    if m.err.ini == 1 then
        return
    m.err.ini     = 1
    m.err.handler = ''
    m.err.cleanup = ';'
    m.err.opt     = ''
    parse source m.err.os .
    m.err.ispf    = 0
    m.err.screen  = ''
    if m.err.os \== 'LINUX' then
        if sysVar('sysISPF') = 'ACTIVE' then do
            m.err.ispf = 1
            address ispExec 'vget zScreen shared'
            m.err.screen = zScreen
            end
    return
endProcedure errIni

/* configure err -----------------------------------------------------*/
errReset: procedure expose m.
    call errIni
    parse arg m.err.opt, m.err.handler
    if pos('I', translate(m.err.opt)) > 0 & m.err.ispf then
        address ispExec 'control errors return'
    return
endSubroutine errReset

/*--- error routine: abend with message ------------------------------*/
err:
    parse arg ggTxt, ggOpt
    call errIni
    drop err handler cleanup opt call return
    if ggOpt == '' & m.err.handler \== '' then
        interpret m.err.handler
    call errSay 'f}'ggTxt
    call errCleanup
    if ggOpt == '' then
        ggOpt = m.err.opt
    upper ggOpt
    if pos('T', ggOpt) > 0  then do
        trace ?r
        say 'trace ?r in err'
        end
    if pos('H', ggOpt) > 0 & m.err.eCat == 'f' then do
        call errSay ' }errorhandler exiting with divide by zero' ,
                                   'to show stackHistory'
        x = 1 / 0
        end
    call errSay ' }errorhandler exiting with exit(12)'
    exit errSetRc(12)
endSubroutine err

/*--- set rc for ispf: -------------------------------------------------
    if a cmd is run by ispStart, its RC is ignored,
         but ISPF passes the value of the shared variable zIspfRc
         back as return code
----------------------------------------------------------------------*/
errSetRc: procedure expose m.
parse arg zIspfRc
    if m.err.ispf then
        address ispExec vput 'zIspfRc' shared
    return zIspfRc
endProcedure errSetRc

/*--- error routine: user message cleanup exit -----------------------*/
errAddCleanup: procedure expose m.
parse arg code
    call errIni
        /* concatenate backwards, then it is executed also backwards */
    m.err.cleanup = ';'code || m.err.cleanup
    return
endProcedure errAddCleanup

errRmCleanup: procedure expose m.
parse arg code
    call errIni
    cx = pos(';'code';', m.err.cleanup)
    if cx > 0 then
        m.err.cleanup = left(m.err.cleanup, cx) ,
                     || substr(m.err.cleanup, cx + length(code)+2)
    return
endProcedure errRmCleanup

errCleanup: procedure expose m.
    call errIni
    errCleanup = m.err.cleanup
    if errCleanup = ';' then
        return
    m.err.cleanup = ';'
    say 'err cleanup begin' errCleanup
    interpret errCleanup
    say 'err cleanup end' errCleanup
    return
endProcedure errCleanup

/*--- say an errorMessage msg with pref and linesplits --------------*/
errSay: procedure expose m.
parse arg msg
    return saySt(errMsg(msg))

/*--- prefix an errormessage with pref,
          split it into lines at \n to stem m.err -------------------*/
errMsg: procedure expose m.
parse arg msg
    m.err.eCat = 'f'
    do while substr(msg, 2, 1) == '}'
        parse var msg m.err.eCat '}' msg
        end
    if m.err.eCat <> '' then do
       parse source . . ggS3 .                       /* current rexx */
       pTxt = ',error,fatal error,input error,syntax error,warning,'
       px = pos(','m.err.eCat, pTxt)
       if px < 1 then do
           m.err.eCat = 'f'
           px = pos(','m.err.eCat, pTxt)
           end
       msg = substr(pTxt, px+1, pos(',', pTxt, px+2)-px-1) ,
             'in' ggS3':' msg
       end
    return splitNl(err, msg)           /* split lines at \n */
endProcedure errMsg

splitNL: procedure expose m.
parse arg st, msg
    bx = 1
    do lx=1 to 20
        ex = pos('\n', msg, bx)
        if ex < bx then
            leave
        m.st.lx = substr(msg, bx, ex-bx)
        bx = ex+2
        end
    m.st.lx = substr(msg, bx)
    m.st.0 = lx
    return st
endProcedure splitNL

/*--- say (part of) the lines of a stem ----------------------------*/
saySt: procedure expose m.
parse arg st, fx, tx
    do lx=word(fx 1, 1) to word(tx m.st.0, 1)
        say m.st.lx
        end
    return st
endProcedure saySt

/*--- out (part of) the lines of a stem ----------------------------*/
outSt: procedure expose m.
parse arg st, fx, tx
    do lx=word(fx 1, 1) to word(tx m.st.0, 1)
        call out m.st.lx
        end
    return st
endProcedure outSt

/*--- say a trace message if m.trace is set --------------------------*/
debug: procedure expose m.
parse arg msg
    if m.debug == 1 then
        say 'debug:' msg
    return
endProcedure debug

/*--- output a trace if m.trace is set -------------------------------*/
trc: procedure expose m.
parse arg msg
    if m.trace == 1 then
        call out 'trc:' msg
    return
endProcedure trc

/*--- assert that the passed rexx expression evaluates to true -------*/
assert:
    interpret 'assertRes =' arg(1)
    if assertRes \==1 then
        call err 'assert failed' arg(1) '==>' assertRes':' arg(2)
    return
endProcedure assert

/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure expose m.
parse arg msg
    call errSay 'i}'msg
    call help 0
    call err 'i}'msg
endProcedure errHelp

/*--- display the first comment block of the source as help ----------*/
help: procedure expose m.
parse arg doClear
    if doClear \== 0 then
        address tso 'clear'
    parse source . . s3 .
    say right(' help for rexx' s3, 72, '*')
    do lx=1 while pos('/*', sourceLine(lx)) < 1
        if lx > 10 then
            return err('initial commentblock not found for help')
        end
    doInc = 1
    ho = m.err.helpOpt
    do lx=lx+1 to sourceline() while pos('*/', sourceline(lx)) = 0
        li = strip(sourceLine(lx), 't')
        cx = lastPos('{', li)
        if cx > 0 then do
            if length(ho) = 1 then
                doInc = cx = length(li) | pos(ho, li, cx+1) > 0
            li = left(li, cx-1)
            end
        if doInc then
            say li
        end
    say right(' end help for rexx' s3, 72, '*')
    return 4
endProcedure help

/* copy err end   *****************************************************/
/* copy ut begin  *****************************************************/
/*--- if function  warning all3 arguments get evaluated|
                   e.g if(x=0, 'infinity', 1/0) will fail| -----------*/
if: procedure expose m.
parse arg co, ifTrue, ifFalse
    if co then
        return ifTrue
    else
        return ifFalse
endProcedure if
/*--- embedded ASSignement:
      assign the second argument to the variable with name in first arg
      and return the value assigned ----------------------------------*/
ass:
    call value arg(1), arg(2)
    return arg(2)
/*--- embedded ASSignement only if NotNull:
      assign the second argument to the variable with name in first arg
      if the second arg is not null, return new value ---------------*/
assIf:
    if arg(2) == '' then
        return value(arg(1))
    call value arg(1), arg(2)
    return arg(2)

/*--- return first nonNull argument ---------------------------------*/
nn:
    if arg(1) \== '' then
        return arg(1)
    if arg(2) \== '' then
        return arg(2)
    call err 'nn() both args empty'

/*--- embedded ASSignement return NotNull:
      assign the second argument to the variable with name in first arg
      and return 1 if value not null, 0 if null ----------------------*/
assNN:
    call value arg(1), arg(2)
    return arg(2) \== ''

/*--- return current time and cpu usage ------------------------------*/
timing: procedure expose m.
return return time() 'ela='time('E') 'cpu='sysvar('syscpu'),
            'su='sysvar('syssrv')

timingTest: procedure expose m.
    say 'begin' timing()  sysvar('sysnode')
    do 30000000
       end
    say 'end  ' timing()
return

/*--- sleep several seconds ------------------------------------------*/
sleep: procedure expose m.
parse arg secs, sayIt
    if sayit <> 0 then
        say 'sleeping' secs 'secs' time()
    CALL SYSCALLS 'ON'
    ADDRESS SYSCALL "sleep" secs
    CALL SYSCALLS 'OFF'
    if sayit <> 0 then
        say 'slept' secs 'secs' time()
    return
endProcedure sleep

/*--- elongate inp with spaces up to given len -----------------------*/
elong: procedure expose m.
parse arg inp, len
    if length(inp) >= len then
        return inp
    return left(inp, len)
endProcedure elong

/*--- quote string txt using quoteChar qu ("""" ==> ") ---------------*/
quote: procedure expose m.
parse arg txt, qu
    if qu = '' then
        qu = '"'
    res = qu
    ix = 1
    do forever
        qx = pos(qu, txt, ix)
        if qx = 0 then
            return res || substr(txt, ix) || qu
        res = res || substr(txt, ix, qx-ix) || qu || qu
        ix = qx + length(qu)
        end
endProcedure quote

/*--- return the count of occurrences of needle in heyStack ----------*/
posCount: procedure expose m.
parse arg needle, hayStack, start, fin
    if start = '' then
        start = 1
    if fin = '' then
        fin = length(hayStack) + 1 - length(needle)
    do cnt = 0 by 1
        start = pos(needle, haystack, start)
        if start < 1 | start > fin then
             return cnt
        start = start + length(needle)
        end
endProcedure posCount

repAll: procedure expose m.
parse arg src, w, new
    res = ''
    cx = 1
    do forever
        nx = pos(w, src, cx)
        if nx < 1 then
            return res || substr(src, cx)
        res = res || substr(src, cx, nx-cx) || new
        cx = nx + length(w)
        end
endProcedure repAll

repAllWords: procedure expose m.
parse arg src, w, new
    res = ''
    wx = 0
    cx = 1
    do forever
        wx = wordPos(w, src, wx+1)
        if wx < 1 then
            return res || substr(src, cx)
        nx = wordindex(src, wx)
        res = res || substr(src, cx, nx-cx) || new
        cx = nx + length(w)
        end
endProcedure repAllWords
/* copy ut end ********************************************************/
----version||| zstatOld --------------------------------------------*/
/*REXX*/

TRACE 0

ADDRESS ISPEXEC                      /* ISPEXEC-SERVICE ADRESSIEREN*/

ADDRESS TSO 'SUBCOM DSNREXX'               /*HOST CMD ENV AVAILABLE*/
IF RC THEN                                 /*NO, LET'S MAKE ONE*/
S_RC = RXSUBCOM('ADD','DSNREXX','DSNREXX') /*ADD HOST CMD ENV*/
IF RC ^= 0 & RC^= 1 THEN CALL SQLCA(PREPARE DSNREXX)

ORDERFILE = 'DSN.DBX.AUFTRAG'
DDLFILE   = 'DSN.DBX.CDL'
WSLFILE   = 'DSN.DBA.CLON.WSLSRC'
INTENTION = ' '
SEARCH_ZS = 'NO DATE SPECIFIED'
WORKLIST  = 'ALL FOR SPECIFIED MIGRATION-DATE'

ZS_MEMBER = 'N'
MEMBNAME  = ''
ZSMEMBER  = ''
DDLMEMBER = ''
WSLMEMBER = ''
PREVIOUS_MEMBER = ''    /* UM (UNNÖTIGE) DOPPELTE COMPARES OHNE
                           SCHREIBEN EINES CDL MEMBERS AUSZUSCHLIESSEN.
                           STATISTIKEN WÜRDEN SONST VERFÄLSCHT DA
                           DOPPELTE ZÄHLUNG DER DDL CHANGES   */

APPLIDFILE = ''
GEBIETFILE = ''
DESCRFILE  = ''

COLLECT_GEBIET     = 'N'
GEBIET             = ''
GEBIET_VDPS        = ''
GEBIET_COUNT       = 0
GEBIET_PREV        = ''
OUTPUT_APPLID      = ''
OUTPUT_APPLID_DESC = ''

INPUTC = 1
MEMB_C = 1
COUNT  = 1
MEMBER_FOUND = 'N'

CHANGE_REQUESTS.0 = 0
COMP_NACHTRAEGE.0 = 0
VERS_NACHTRAEGE.0 = 0

CRE_DB_STAT.0  = 0
CRE_TS_STAT.0  = 0
CRE_TBL_STAT.0 = 0
CRE_IX_STAT.0  = 0
CRE_UIX_STAT.0 = 0
CRE_VW_STAT.0  = 0
CRE_TR_STAT.0  = 0
CRE_ALI_STAT.0 = 0
CRE_SYN_STAT.0 = 0

ALTER_STAT.0       = 0
ALTER_ADMIN_STAT.0 = 0
COMMENT_STAT.0     = 0
LABEL_STAT.0       = 0

DROP_DB_STAT.0  = 0
DROP_TS_STAT.0  = 0
DROP_TBL_STAT.0 = 0
DROP_IX_STAT.0  = 0
DROP_VW_STAT.0  = 0
DROP_TR_STAT.0  = 0
DROP_ALI_STAT.0 = 0
DROP_SYN_STAT.0 = 0

ADDRESS TSO "CLEAR" /* BILDSCHIRM LÖSCHEN */

CALL READ_APPLID_FILE

SAY 'AN WELCHER AUSWERTUNGSART SIND SIE INTERESSIERT?'
SAY '   -> FUER EINEN OFFIZIELLEN ZUEGELSCHUB - "M" + "ENTER"'
SAY '   -> FUER SPEZIELLE WORKLISTEN          - "S" + "ENTER"'
PULL INTENTION

IF INTENTION <> 'M' & INTENTION <> 'S' THEN DO
   SAY 'FALSCHE EINGABE - PROGRAM WIRD BEENDET...'
   EXIT;
END


/* VERARBEITUNG FÜR INTENTION = M */
IF INTENTION = 'M' THEN DO

   SAY 'FUER WELCHES ZUEGELSCHUBDATUM MOECHTEN SIE IHRE AUSWERTUNGEN'
   SAY 'ERSTELLEN LASSEN? - EINGABE-FORMAT: YYYYMMDD'
   PULL SEARCH_ZS

   IF SEARCH_ZS = ' ' THEN DO
      SAY 'KEIN DATUM EINGEGEBEN - PROGRAM WIRD BEENDET...'
      EXIT;
   END

   SAY 'DETAILS FÜR WORKLISTEN ANZEIGEN?'
   SAY '   -> JA   - "J" + "ENTER"'
   SAY '   -> NEIN - "N" + "ENTER"'
   PULL SHOWDETAILS

   IF SHOWDETAILS <> 'J' & SHOWDETAILS <> 'N' THEN DO
      SAY 'FALSCHE EINGABE - PROGRAM WIRD BEENDET...'
      EXIT;
   END

   ADDRESS TSO "CLEAR" /* BILDSCHIRM LÖSCHEN */

   SAY '   AUFTRAGS-DATEI:' ORDERFILE
   SAY '        DDL-DATEI:' DDLFILE
   SAY '        WSL-DATEI:' WSLFILE
   SAY 'ZUEGELSCHUB-DATUM:' SEARCH_ZS
   SAY '         WORKLIST:' WORKLIST
   SAY ' '

   "LMINIT DATAID(MEMVAR) DATASET('"ORDERFILE"') ENQ(SHR)"
   "LMOPEN DATAID(&MEMVAR) OPTION(INPUT)"

   CALL SEARCH_ZSMEMBER
   "LMFREE DATAID(&MEMVAR)"

   "LMINIT DATAID(MEMVAR) DATASET('"DDLFILE"') ENQ(SHR)"
   "LMOPEN DATAID(&MEMVAR) OPTION(INPUT)"

   CALL COLLECT_DDLFILE_STATS
   "LMFREE DATAID(&MEMVAR)"

   "LMINIT DATAID(MEMVAR) DATASET('"WSLFILE"') ENQ(SHR)"
   "LMOPEN DATAID(&MEMVAR) OPTION(INPUT)"

   CALL COLLECT_WSLFILE_STATS
   "LMFREE DATAID(&MEMVAR)"

   COLLECT_GEBIET = 'Y'

   "LMINIT DATAID(MEMVAR) DATASET('"DDLFILE"') ENQ(SHR)"
   "LMOPEN DATAID(&MEMVAR) OPTION(INPUT)"

   CALL COLLECT_DDLFILE_STATS
   "LMFREE DATAID(&MEMVAR)"

   "LMINIT DATAID(MEMVAR) DATASET('"WSLFILE"') ENQ(SHR)"
   "LMOPEN DATAID(&MEMVAR) OPTION(INPUT)"

   CALL COLLECT_WSLFILE_STATS
   "LMFREE DATAID(&MEMVAR)"

END

/* VERARBEITUNG FÜR INTENTION = S */
IF INTENTION = 'S' THEN DO

   SAY 'FUER WELCHES ZUEGELSCHUBDATUM MOECHTEN SIE IHRE AUSWERTUNGEN'
   SAY 'ERSTELLEN LASSEN? - EINGABE-FORMAT: YYYYMMDD, YYYYMM, YYYY, ...'
   SAY '"ENTER"-TASTE FUER KEIN SPEZIELLES DATUM.'
   PULL SEARCH_ZS

   IF SEARCH_ZS = ' ' THEN DO
      SEARCH_ZS = 'NO DATE SPECIFIED'
   END

   SAY 'BITTE GEBEN SIE IHRE WORKLISTE(N) EIN:'
   SAY 'MEHRERE WORKLISTEN ODER WILDCARDS SIND MOEGLICH.'
   SAY 'EINGABE DURCH DRUECKEN DER "ENTER"-TASTE ABSCHLIESSEN.'
   SAY 'FORMAT: MF01001W, MF01, MF, ...'
   PULL WORKLIST
   WORKLIST.INPUTC = WORKLIST
   DO WHILE WORKLIST <> ' ' /* REPEAT INPUT UNTIL BLANK */
      INPUTC = INPUTC + 1
      PULL WORKLIST
      WORKLIST.INPUTC = WORKLIST
   END

   IF WORKLIST.1 = '' THEN DO
      SAY 'KEINE WORKLISTE SPEZIFIZIERT - PROGRAMM WIRD BEENDET...'
      EXIT;
   END

   SAY 'DETAILS FÜR WORKLISTEN ANZEIGEN?'
   SAY '   -> JA   - "J" + "ENTER"'
   SAY '   -> NEIN - "N" + "ENTER"'
   PULL SHOWDETAILS

   IF SHOWDETAILS <> 'J' & SHOWDETAILS <> 'N' THEN DO
      SAY 'FALSCHE EINGABE - PROGRAM WIRD BEENDET...'
      EXIT;
   END

   ADDRESS TSO "CLEAR" /* BILDSCHIRM LÖSCHEN */

   SAY '  AUFTRAGS-DATEI:' ORDERFILE
   SAY '       DDL-DATEI:' DDLFILE
   SAY '       WSL-DATEI:' WSLFILE
   SAY 'ZUEGELSCHUB-DATUM:' SEARCH_ZS
   SAY '        WORKLIST:' WORKLIST
   SAY ' '
   X = 1
   DO UNTIL X >= INPUTC
      SAY '      WORKLIST:' WORKLIST.X
      X = X + 1
   END
   SAY ' '

   "LMINIT DATAID(MEMVAR) DATASET('"ORDERFILE"') ENQ(SHR)"
   "LMOPEN DATAID(&MEMVAR) OPTION(INPUT)"

   CALL SEARCH_ZSMEMBER
   "LMFREE DATAID(&MEMVAR)"

   "LMINIT DATAID(MEMVAR) DATASET('"DDLFILE"') ENQ(SHR)"
   "LMOPEN DATAID(&MEMVAR) OPTION(INPUT)"

   CALL COLLECT_DDLFILE_STATS
   "LMFREE DATAID(&MEMVAR)"

   "LMINIT DATAID(MEMVAR) DATASET('"WSLFILE"') ENQ(SHR)"
   "LMOPEN DATAID(&MEMVAR) OPTION(INPUT)"

   CALL COLLECT_WSLFILE_STATS
   "LMFREE DATAID(&MEMVAR)"

END

IF MEMBER_FOUND = 'Y' THEN DO
   CALL OUTPUT_STATS
   EXIT;
END

IF MEMBER_FOUND = 'N' THEN DO
   SAY ' '
   SAY 'KEINE DATEN FUER EINGEGEBENE PARAMETER GEFUNDEN|'
   SAY ' '
   SAY '   AUFTRAGS-DATEI:' ORDERFILE
   SAY '        DDL-DATEI:' DDLFILE
   SAY '        WSL-DATEI:' WSLFILE
   SAY 'ZUEGELSCHUB-DATUM:' SEARCH_ZS
   SAY '         WORKLIST:' WORKLIST
   SAY ' '
   SAY 'PROGRAMM WIRD BEENDET...'
   EXIT;
END

/******************************************************************/
READ_APPLID_FILE:
/******************************************************************/

FILECOUNTER = 1

ADDRESS DSNREXX "CONNECT "DBOC
        IF SQLCODE <> 0 THEN CALL SQLCA

SQL_S1="SELECT GEBIETSPOINTER    ",
       "      ,GEBPOINT_BEZEICHNUNG                         ",
       "      ,BANKANWENDUNG                                ",
       "  FROM RZ2DD.TACCT_GEBPOINT;                        "

ADDRESS DSNREXX "EXECSQL DECLARE C1 CURSOR FOR S1 ";
IF (SQLCODE < 0) THEN CALL SQLCA

ADDRESS DSNREXX "EXECSQL PREPARE S1 FROM :SQL_S1 ";
IF (SQLCODE < 0) THEN CALL SQLCA

ADDRESS DSNREXX "EXECSQL OPEN C1 ";
IF (SQLCODE < 0) THEN CALL SQLCA

DO UNTIL (SQLCODE^=0)
   ADDRESS DSNREXX ,
          "EXECSQL FETCH C1 INTO :H0,:H1,:H2"

   GEBIETFILE.FILECOUNTER = H0
   DESCRFILE.FILECOUNTER  = H1
   APPLIDFILE.FILECOUNTER = H2

   FILECOUNTER = FILECOUNTER + 1

END

ADDRESS DSNREXX "DISCONNECT";
IF SQLCODE <> 0 THEN CALL SQLCA

RETURN;

/******************************************************************/
SEARCH_ZSMEMBER:
/******************************************************************/

IF INTENTION = 'M' THEN DO
   DO FOREVER
      "LMMLIST DATAID(&MEMVAR) OPTION(LIST) MEMBER(MEMBNAME)"
      IF RC > 0 THEN LEAVE            /* END OF FILE            */
      CALL READ_MEMB
   END
END

IF INTENTION = 'S' THEN DO
   DO FOREVER
      "LMMLIST DATAID(&MEMVAR) OPTION(LIST) MEMBER(MEMBNAME)"
      IF RC > 0 THEN LEAVE            /* END OF FILE            */

      Y = 1
      DO UNTIL Y > INPUTC
         IF POS(WORKLIST.Y,MEMBNAME) > 0 THEN DO
            CALL READ_MEMB
         END
      Y = Y + 1
      END
   END
END

RETURN;


/******************************************************************/
READ_MEMB:
/******************************************************************/

"LMMFIND DATAID(&MEMVAR) MEMBER("MEMBNAME")"

DO FOREVER
   "LMGET DATAID(&MEMVAR) MODE(INVAR) DATALOC(LINE)
          DATALEN(LINELEN) MAXLEN(160)"
   IF RC > 0 THEN LEAVE            /* END OF FILE                */

   PARSE UPPER VAR LINE V1 V2 V3 V4 V5 V6 V7 V8 V9

   IF INTENTION = 'M' & POS(SEARCH_ZS,V2) > 0 THEN DO
      MEMBER_FOUND = 'Y'
      IF SHOWDETAILS = 'J' THEN DO
         SAY ' '
         SAY MEMBNAME '- AUSZUFUEHREN FUER ZS AM ' V2 ' UM ' V3
      END
      ZS_MEMBER = 'Y'
      GEBIET = SUBSTR(MEMBNAME,1,2)
      GEBIET_VDPS = SUBSTR(MEMBNAME,1,4)

      IF GEBIET <> GEBIET_PREV THEN DO
         GEBIET_COUNT = GEBIET_COUNT + 1
         GEBIET.GEBIET_COUNT = SUBSTR(MEMBNAME,1,2)
         GEBIET_PREV         = SUBSTR(MEMBNAME,1,2)
         /* INIT VARIABLE */
         CHANGE_REQUESTS.GEBIET_COUNT  = 0
         COMP_NACHTRAEGE.GEBIET_COUNT  = 0
         VERS_NACHTRAEGE.GEBIET_COUNT  = 0
         CRE_DB_STAT.GEBIET_COUNT      = 0
         CRE_TS_STAT.GEBIET_COUNT      = 0
         CRE_TBL_STAT.GEBIET_COUNT     = 0
         CRE_IX_STAT.GEBIET_COUNT      = 0
         CRE_UIX_STAT.GEBIET_COUNT     = 0
         CRE_VW_STAT.GEBIET_COUNT      = 0
         CRE_TR_STAT.GEBIET_COUNT      = 0
         CRE_ALI_STAT.GEBIET_COUNT     = 0
         CRE_SYN_STAT.GEBIET_COUNT     = 0
         ALTER_STAT.GEBIET_COUNT       = 0
         ALTER_ADMIN_STAT.GEBIET_COUNT = 0
         COMMENT_STAT.GEBIET_COUNT     = 0
         LABEL_STAT.GEBIET_COUNT       = 0
         DROP_DB_STAT.GEBIET_COUNT     = 0
         DROP_TS_STAT.GEBIET_COUNT     = 0
         DROP_TBL_STAT.GEBIET_COUNT    = 0
         DROP_IX_STAT.GEBIET_COUNT     = 0
         DROP_VW_STAT.GEBIET_COUNT     = 0
         DROP_TR_STAT.GEBIET_COUNT     = 0
         DROP_ALI_STAT.GEBIET_COUNT    = 0
         DROP_SYN_STAT.GEBIET_COUNT    = 0
         /* INIT VARIABLE */
         DO APPLID_CHECK = 1 TO FILECOUNTER
            IF GEBIET_VDPS = 'VDPS' THEN DO
               GEBIET = 'VV'
            END
            IF GEBIET = GEBIETFILE.APPLID_CHECK THEN DO
               OUTPUT_APPLID.GEBIET_COUNT = APPLIDFILE.APPLID_CHECK
               OUTPUT_APPLID_DESC.GEBIET_COUNT = DESCRFILE.APPLID_CHECK
            IF SHOWDETAILS = 'J' THEN DO
               SAY '---> GEBIETSPOINTER:' GEBIET
               SAY '---> APPLICATION-ID:' OUTPUT_APPLID.GEBIET_COUNT
               SAY '--->                ' OUTPUT_APPLID_DESC.GEBIET_COUNT
            END
            END
         END
      END
      IF GEBIET = GEBIET_PREV THEN DO
         GEBIET_PREV = SUBSTR(MEMBNAME,1,2)
         CHANGE_REQUESTS.GEBIET_COUNT = CHANGE_REQUESTS.GEBIET_COUNT + 1
         CHANGE_REQUESTS.0 = CHANGE_REQUESTS.0 + 1
      END
   END

   IF SEARCH_ZS = 'NO DATE SPECIFIED' THEN DO
      IF INTENTION = 'S' & V1 = 'ZUEGELSCHUB' THEN DO
         MEMBER_FOUND = 'Y'
         IF SHOWDETAILS = 'J' THEN DO
            SAY ' '
            SAY MEMBNAME '- AUSZUFUEHREN FUER ZS AM ' V2 ' UM ' V3
         END
         CHANGE_REQUESTS.0 = CHANGE_REQUESTS.0 + 1
         ZS_MEMBER = 'Y'
      END
   END

   IF SEARCH_ZS <> 'NO DATE SPECIFIED' THEN DO
      IF INTENTION = 'S' & POS(SEARCH_ZS,V2) > 0 THEN DO
         MEMBER_FOUND = 'Y'
         IF SHOWDETAILS = 'J' THEN DO
            SAY ' '
            SAY MEMBNAME '- AUSZUFUEHREN FUER ZS AM ' V2 ' UM ' V3
         END
         CHANGE_REQUESTS.0 = CHANGE_REQUESTS.0 + 1
         ZS_MEMBER = 'Y'
      END
   END

   IF V1 = 'COMPARE' & ZS_MEMBER = 'Y' THEN DO
      DDLMEMBER.MEMB_C = SUBSTR(MEMBNAME,1,7) V2
      DDLMEMBER.MEMB_C = SPACE(DDLMEMBER.MEMB_C,0)
      IF SHOWDETAILS = 'J' THEN DO
         SAY MEMBNAME '- COMPARE' V2 'AM' V5 'UM' V6 ,
             ' - DELTA FILE:' DDLMEMBER.MEMB_C
      END
      IF PREVIOUS_MEMBER <> DDLMEMBER.MEMB_C THEN DO
         PREVIOUS_MEMBER = DDLMEMBER.MEMB_C
         MEMB_C = MEMB_C + 1
      END

      IF PREVIOUS_MEMBER = DDLMEMBER.MEMB_C THEN DO
         PREVIOUS_MEMBER = DDLMEMBER.MEMB_C
      END
      COMP_NACHTRAEGE.0 = COMP_NACHTRAEGE.0 + 1
      COMP_NACHTRAEGE.GEBIET_COUNT = COMP_NACHTRAEGE.GEBIET_COUNT + 1
   END

   IF V1 = 'VERSION' & ZS_MEMBER = 'Y' THEN DO
      WSLMEMBER_ORIG = SUBSTR(MEMBNAME,1,7) 'Q'
      IF SHOWDETAILS = 'J' THEN DO
         SAY MEMBNAME '- VERSION' V2 'AM' V5 'UM' V6
      END
      VERS_NACHTRAEGE.0 = VERS_NACHTRAEGE.0 + 1
      VERS_NACHTRAEGE.GEBIET_COUNT = VERS_NACHTRAEGE.GEBIET_COUNT + 1
      VERSION = 'Y'
   END

END

IF ZS_MEMBER = 'Y' & VERSION = 'Y' THEN DO
   WSLMEMBER.COUNT = SUBSTR(MEMBNAME,1,7) 'Q'
   WSLMEMBER.COUNT = SPACE(WSLMEMBER.COUNT,0)
   COUNT = COUNT + 1
END

ZS_MEMBER = 'N'
VERSION = 'N'

RETURN;

/******************************************************************/
COLLECT_DDLFILE_STATS:
/******************************************************************/

MEMBNAME = ""

DO FOREVER
   "LMMLIST DATAID(&MEMVAR) OPTION(LIST) MEMBER(MEMBNAME)"
   IF RC > 0 THEN LEAVE            /* END OF FILE                */

   X = 1
   Y = 1

   DO WHILE X < MEMB_C
      IF MEMBNAME = DDLMEMBER.X & COLLECT_GEBIET = 'N' THEN DO
         S = 0
         CALL READ_DDL_MEMB_DDLFILE
         X = X + 1
      END
      IF MEMBNAME = DDLMEMBER.X & COLLECT_GEBIET = 'Y' THEN DO
         DO WHILE Y < GEBIET_COUNT
            IF SUBSTR(DDLMEMBER.X,1,2) = GEBIET.Y THEN DO
               S = Y
               CALL READ_DDL_MEMB_DDLFILE
            END
         Y = Y + 1
         END
      END
   X = X + 1
   END
END
RETURN;


/******************************************************************/
READ_DDL_MEMB_DDLFILE:
/******************************************************************/

"LMMFIND DATAID(&MEMVAR) MEMBER("MEMBNAME")"

DO FOREVER
   "LMGET DATAID(&MEMVAR) MODE(INVAR) DATALOC(LINE)
          DATALEN(LINELEN) MAXLEN(160)"
   IF RC > 0 THEN LEAVE            /* END OF FILE                */

   PARSE UPPER VAR LINE V1 V2

   IF POS('CREATE',V2) > 0 & POS('DATABASE',V2) > 0 THEN DO
      CRE_DB_STAT.S = CRE_DB_STAT.S + 1
   END

   IF POS('CREATE',V2) > 0 & POS('TABLESPACE',V2) > 0 THEN DO
      CRE_TS_STAT.S = CRE_TS_STAT.S + 1
   END

   IF POS('CREATE',V2) > 0 & POS('TABLE',V2) > 0 &,
      POS('TABLESPACE',V2) = 0 THEN DO
      CRE_TBL_STAT.S = CRE_TBL_STAT.S + 1
   END

   IF POS('CREATE',V2) > 0 & POS('UNIQUE',V2) > 0 &,
      POS('INDEX',V2) > 0 THEN DO
      CRE_UIX_STAT.S = CRE_UIX_STAT.S + 1
   END

   IF POS('CREATE',V2) > 0 & POS('INDEX',V2) > 0 &,
      POS('UNIQUE',V2) = 0 THEN DO
      CRE_IX_STAT.S = CRE_IX_STAT.S + 1
   END

   IF POS('CREATE',V2) > 0 & POS('VIEW',V2) > 0 THEN DO
      CRE_VW_STAT.S = CRE_VW_STAT.S + 1
   END

   IF POS('CREATE',V2) > 0 & POS('TRIGGER',V2) > 0 THEN DO
      CRE_TR_STAT.S = CRE_TR_STAT.S + 1
   END

   IF POS('CREATE',V2) > 0 & POS('ALIAS',V2) > 0 THEN DO
      CRE_ALI_STAT.S = CRE_ALI_STAT.S + 1
   END

   IF POS('CREATE',V2) > 0 & POS('SYNONYM',V2) > 0 THEN DO
      CRE_SYN_STAT.S = CRE_SYN_STAT.S + 1
   END


   IF POS('ALTER',V2) > 0 & POS('ADMIN',V2) = 0,
      & POS('SET DATA TYPE',V2) = 0 THEN DO
      ALTER_STAT.S = ALTER_STAT.S + 1
   END

   IF POS('ADMIN',V2) > 0 & POS('DROP',V2) > 0 THEN DO
      ALTER_ADMIN_STAT.S = ALTER_ADMIN_STAT.S + 1
   END

   IF POS('ALTER',V2) > 0 & POS('SET DATA TYPE',V2) > 0 THEN DO
      ALTER_STAT.S = ALTER_STAT.S
   END


   IF POS('LABEL',V2) > 0 & POS('ON',V2) > 0 THEN DO
      LABEL_STAT.S = LABEL_STAT.S + 1
   END

   IF POS('COMMENT',V2) > 0 & POS('ON',V2) > 0 THEN DO
      COMMENT_STAT.S = COMMENT_STAT.S + 1
   END


   IF POS('DROP',V2) > 0 & POS('DATABASE',V2) > 0 THEN DO
      DROP_DB_STAT.S = DROP_DB_STAT.S + 1
   END

   IF POS('DROP',V2) > 0 & POS('TABLESPACE',V2) > 0 THEN DO
      DROP_TS_STAT.S = DROP_TS_STAT.S + 1
   END

   IF POS('DROP',V2) > 0 & POS('TABLE',V2) > 0 THEN DO
      DROP_TBL_STAT.S = DROP_TBL_STAT.S + 1
   END

   IF POS('DROP',V2) > 0 & POS('INDEX',V2) > 0 THEN DO
      DROP_IX_STAT.S = DROP_IX_STAT.S + 1
   END

   IF POS('DROP',V2) > 0 & POS('VIEW',V2) > 0 THEN DO
      DROP_VW_STAT.S = DROP_VW_STAT.S + 1
   END

   IF POS('DROP',V2) > 0 & POS('VW',V2) > 0 THEN DO
      DROP_VW_STAT.S = DROP_VW_STAT.S + 1
   END

   IF POS('DROP',V2) > 0 & POS('TRIGGER',V2) > 0 THEN DO
      DROP_TR_STAT.S = DROP_TR_STAT.S + 1
   END

   IF POS('DROP',V2) > 0 & POS('ALIAS',V2) > 0 THEN DO
      DROP_ALI_STAT.S = DROP_ALI_STAT.S + 1
   END

   IF POS('DROP',V2) > 0 & POS('SYNONYM',V2) > 0 THEN DO
      DROP_SYN_STAT.S = DROP_SYN_STAT.S + 1
   END

END
RETURN;

/******************************************************************/
COLLECT_WSLFILE_STATS:
/******************************************************************/

MEMBNAME = ' '              /* INITIALISE MEMBNAME */

DO FOREVER
   "LMMLIST DATAID(&MEMVAR) OPTION(LIST) MEMBER(MEMBNAME)"
   IF RC > 0 THEN LEAVE            /* END OF FILE                */

   X = 1
   Y = 1

   DO WHILE X < COUNT
      IF MEMBNAME = WSLMEMBER.X & COLLECT_GEBIET = 'N' THEN DO
         S = 0
         CALL READ_DDL_MEMB_WSLFILE
         X = X + 1
      END
      IF MEMBNAME = WSLMEMBER.X & COLLECT_GEBIET = 'Y' THEN DO
         DO WHILE Y < GEBIET_COUNT
            IF SUBSTR(WSLMEMBER.X,1,2) = GEBIET.Y THEN DO
               S = Y
               CALL READ_DDL_MEMB_WSLFILE
            END
         Y = Y + 1
         END
      END
   X = X + 1
   END
END
RETURN;

/******************************************************************/
READ_DDL_MEMB_WSLFILE:
/******************************************************************/

"LMMFIND DATAID(&MEMVAR) MEMBER("MEMBNAME")"

DO FOREVER
   "LMGET DATAID(&MEMVAR) MODE(INVAR) DATALOC(LINE)
          DATALEN(LINELEN) MAXLEN(80)"
   IF RC > 0 THEN LEAVE            /* END OF FILE                */

   PARSE UPPER VAR LINE V1

   IF POS('CREATE',V1) > 0 & POS('DATABASE',V1) > 0 THEN DO
      CRE_DB_STAT.S = CRE_DB_STAT.S + 1
   END

   IF POS('CREATE',V1) > 0 & POS('TABLESPACE',V1) > 0 THEN DO
      CRE_TS_STAT.S = CRE_TS_STAT.S + 1
   END

   IF POS('CREATE',V1) > 0 & POS('TABLE',V1) > 0 &,
      POS('TABLESPACE',V1) = 0 THEN DO
      CRE_TBL_STAT.S = CRE_TBL_STAT.S + 1
   END

   IF POS('CREATE',V1) > 0 & POS('UNIQUE',V1) > 0 &,
      POS('INDEX',V1) > 0 THEN DO
      CRE_UIX_STAT.S = CRE_UIX_STAT.S + 1
   END

   IF POS('CREATE',V1) > 0 & POS('INDEX',V1) > 0 &,
      POS('UNIQUE',V1) = 0 THEN DO
      CRE_IX_STAT.S = CRE_IX_STAT.S + 1
   END

   IF POS('CREATE',V1) > 0 & POS('VIEW',V1) > 0 THEN DO
      CRE_VW_STAT.S = CRE_VW_STAT.S + 1
   END

   IF POS('CREATE',V1) > 0 & POS('TRIGGER',V1) > 0 THEN DO
      CRE_TR_STAT.S = CRE_TR_STAT.S + 1
   END

   IF POS('CREATE',V1) > 0 & POS('ALIAS',V1) > 0 THEN DO
      CRE_ALI_STAT.S = CRE_ALI_STAT.S + 1
   END

   IF POS('CREATE',V1) > 0 & POS('SYNONYM',V1) > 0 THEN DO
      CRE_SYN_STAT.S = CRE_SYN_STAT.S + 1
   END


   IF POS('ALTER',V1) > 0 & POS('ADMIN',V1) = 0 THEN DO
      ALTER_STAT.S = ALTER_STAT.S + 1
   END

   IF POS('LABEL',V1) > 0 & POS('ON',V1) > 0 THEN DO
      LABEL_STAT.S = LABEL_STAT.S + 1
   END

   IF POS('COMMENT',V1) > 0 & POS('ON',V1) > 0 THEN DO
      COMMENT_STAT.S = COMMENT_STAT.S + 1
   END


   IF POS('DROP',V1) > 0 & POS('DATABASE',V1) > 0 THEN DO
      DROP_DB_STAT.S = DROP_DB_STAT.S + 1
   END

   IF POS('DROP',V1) > 0 & POS('TABLESPACE',V1) > 0 THEN DO
      DROP_TS_STAT.S = DROP_TS_STAT.S + 1
   END

   IF POS('DROP',V1) > 0 & POS('TABLE',V1) > 0 THEN DO
      DROP_TBL_STAT.S = DROP_TBL_STAT.S + 1
   END

   IF POS('DROP',V1) > 0 & POS('INDEX',V1) > 0 THEN DO
      DROP_IX_STAT.S = DROP_IX_STAT.S + 1
   END

   IF POS('DROP',V1) > 0 & POS('VIEW',V1) > 0 THEN DO
      DROP_VW_STAT.S = DROP_VW_STAT.S + 1
   END

   IF POS('DROP',V1) > 0 & POS('TRIGGER',V1) > 0 THEN DO
      DROP_TR_STAT.S = DROP_TR_STAT.S + 1
   END

   IF POS('DROP',V1) > 0 & POS('ALIAS',V1) > 0 THEN DO
      DROP_ALI_STAT.S = DROP_ALI_STAT.S + 1
   END

   IF POS('DROP',V1) > 0 & POS('SYNONYM',V1) > 0 THEN DO
      DROP_SYN_STAT.S = DROP_SYN_STAT.S + 1
   END

END
RETURN;

/******************************************************************/
OUTPUT_STATS:
/******************************************************************/

SAY ' '
SAY ' PRESS "ENTER" TO CONTINUE'
PULL

IF INTENTION = 'M' THEN DO
   ADDRESS DSNREXX "CONNECT "DBAF
           IF SQLCODE <> 0 THEN CALL SQLCA

   DELETE="DELETE FROM OA1A.TADM12A1                                ",
          " WHERE ZUEGELSCHUB = '"SEARCH_ZS"';                      "

   SQLTEXT = DELETE
   ADDRESS DSNREXX "EXECSQL DECLARE C2 CURSOR FOR S2"
   ADDRESS DSNREXX "EXECSQL PREPARE S2 FROM :DELETE"
   ADDRESS DSNREXX "EXECSQL EXECUTE S2"
   ADDRESS DSNREXX "EXECSQL COMMIT"
END

OUTPUT_COUNT = 0

DO WHILE OUTPUT_COUNT <= GEBIET_COUNT

ADDRESS TSO "CLEAR" /* BILDSCHIRM LÖSCHEN */


   TOTAL_CREATE.OUTPUT_COUNT = 0
   TOTAL_CREATE.OUTPUT_COUNT = CRE_DB_STAT.OUTPUT_COUNT,
                             + CRE_TS_STAT.OUTPUT_COUNT,
                             + CRE_TBL_STAT.OUTPUT_COUNT,
                             + CRE_IX_STAT.OUTPUT_COUNT,
                             + CRE_UIX_STAT.OUTPUT_COUNT,
                             + CRE_VW_STAT.OUTPUT_COUNT,
                             + CRE_TR_STAT.OUTPUT_COUNT,
                             + CRE_ALI_STAT.OUTPUT_COUNT,
                             + CRE_SYN_STAT.OUTPUT_COUNT

   TOTAL_ALTER.OUTPUT_COUNT = 0
   TOTAL_ALTER.OUTPUT_COUNT = ALTER_STAT.OUTPUT_COUNT,
                            + ALTER_ADMIN_STAT.OUTPUT_COUNT,
                            + COMMENT_STAT.OUTPUT_COUNT,
                            + LABEL_STAT.OUTPUT_COUNT

   TOTAL_DROP.OUTPUT_COUNT = 0
   TOTAL_DROP.OUTPUT_COUNT = DROP_DB_STAT.OUTPUT_COUNT,
                           + DROP_TS_STAT.OUTPUT_COUNT,
                           + DROP_TBL_STAT.OUTPUT_COUNT,
                           + DROP_IX_STAT.OUTPUT_COUNT,
                           + DROP_VW_STAT.OUTPUT_COUNT,
                           + DROP_TR_STAT.OUTPUT_COUNT,
                           + DROP_ALI_STAT.OUTPUT_COUNT,
                           + DROP_SYN_STAT.OUTPUT_COUNT

   FULL_TOTAL.OUTPUT_COUNT = 0
   FULL_TOTAL.OUTPUT_COUNT = TOTAL_CREATE.OUTPUT_COUNT,
                           + TOTAL_ALTER.OUTPUT_COUNT,
                           + TOTAL_DROP.OUTPUT_COUNT

   IF OUTPUT_COUNT = 0 THEN DO
      SAY ' G E S A M T   S T A T I S T I K  -' SEARCH_ZS
      SAY '    TOTAL AUFTRAEGE...........' CHANGE_REQUESTS.OUTPUT_COUNT
      SAY '    TOTAL COMPARES (V7.2 NEU).' COMP_NACHTRAEGE.OUTPUT_COUNT
      SAY '    TOTAL VERSIONS (V7.2 ALT).' VERS_NACHTRAEGE.OUTPUT_COUNT,
          '    NACHTRAEGE.' COMP_NACHTRAEGE.OUTPUT_COUNT +,
                            VERS_NACHTRAEGE.OUTPUT_COUNT -,
                            CHANGE_REQUESTS.OUTPUT_COUNT
      SAY ' '
   END

   IF OUTPUT_COUNT > 0 THEN DO
      IF SUBSTR(OUTPUT_APPLID.OUTPUT_COUNT,1,6) = 'OUTPUT' THEN DO
         OUTPUT_APPLID.OUTPUT_COUNT = 'NA'
         OUTPUT_APPLID_DESC.OUTPUT_COUNT = 'NA'
      END

      IF SHOWDETAILS = 'J' THEN DO
         SAY ' S T A T I S T I K   ' SEARCH_ZS,
             ' G E B I E T S P O I N T E R   ' GEBIET.OUTPUT_COUNT
         SAY ' A P P L - I D   ' OUTPUT_APPLID.OUTPUT_COUNT '-',
                                 OUTPUT_APPLID_DESC.OUTPUT_COUNT
         SAY ' '
      END
   END

   IF SHOWDETAILS = 'J' | OUTPUT_COUNT = 0 THEN DO

   SAY ' C R E A T E   D B 2   O B J E C T S'
   SAY '    TOTAL CREATE..........' TOTAL_CREATE.OUTPUT_COUNT
   SAY ' '
   SAY '    CREATE DATABASE.......' CRE_DB_STAT.OUTPUT_COUNT
   SAY '    CREATE TABLESPACE.....' CRE_TS_STAT.OUTPUT_COUNT
   SAY '    CREATE TABLE..........' CRE_TBL_STAT.OUTPUT_COUNT
   SAY '    CREATE INDEX..........' CRE_IX_STAT.OUTPUT_COUNT
   SAY '    CREATE UNIQUE INDEX...' CRE_UIX_STAT.OUTPUT_COUNT
   SAY '    CREATE VIEW...........' CRE_VW_STAT.OUTPUT_COUNT
   SAY '    CREATE TRIGGER........' CRE_TR_STAT.OUTPUT_COUNT
   SAY '    CREATE ALIAS..........' CRE_ALI_STAT.OUTPUT_COUNT
   SAY '    CREATE SYNONYM........' CRE_SYN_STAT.OUTPUT_COUNT
   SAY ' '
   SAY ' A L T E R   D B 2   O B J E C T S'
   SAY '    TOTAL ALTER...........' TOTAL_ALTER.OUTPUT_COUNT
   SAY ' '
   SAY '    DIVERSE ALTER.........' ALTER_STAT.OUTPUT_COUNT
   SAY '    ADMIN ALTER (=DROP)...' ALTER_ADMIN_STAT.OUTPUT_COUNT
   SAY '    COMMENT ON............' COMMENT_STAT.OUTPUT_COUNT
   SAY '    LABEL ON..............' LABEL_STAT.OUTPUT_COUNT
   SAY ' '
   SAY ' D R O P   D B 2   O B J E C T S'
   SAY '    TOTAL DROP............' TOTAL_DROP.OUTPUT_COUNT
   SAY ' '
   SAY '    DROP DATABASE.........' DROP_DB_STAT.OUTPUT_COUNT
   SAY '    DROP TABLESPACE.......' DROP_TS_STAT.OUTPUT_COUNT
   SAY '    DROP TABLE............' DROP_TBL_STAT.OUTPUT_COUNT
   SAY '    DROP INDEX............' DROP_IX_STAT.OUTPUT_COUNT
   SAY '    DROP VIEW.............' DROP_VW_STAT.OUTPUT_COUNT
   SAY '    DROP TRIGGER..........' DROP_TR_STAT.OUTPUT_COUNT
   SAY '    DROP ALIAS............' DROP_ALI_STAT.OUTPUT_COUNT
   SAY '    DROP SYNONYM..........' DROP_SYN_STAT.OUTPUT_COUNT
   SAY ' ===================================='
   SAY '    TOTAL CHANGED.........' FULL_TOTAL.OUTPUT_COUNT

   IF OUTPUT_COUNT = 0 THEN DO
      SAY ' '
      SAY ' PRESS "ENTER" TO CONTINUE'
      PULL
   END

   END


   IF OUTPUT_COUNT > 0 THEN DO

      ADDRESS DSNREXX "CONNECT "DBAF
              IF SQLCODE <> 0 THEN CALL SQLCA

      INSERT= "INSERT INTO OA1A.TADM12A1 ( "              ,
              "ZUEGELSCHUB             ,"                 ,
              "CHANGE_REQ              ,"                 ,
              "COMPARES                ,"                 ,
              "VERSIONS                ,"                 ,
              "GEBIETSPOINTER          ,"                 ,
              "APPLID                  ,"                 ,
              "APPLID_DESC             ,"                 ,
              "CREATE_TOTAL            ,"                 ,
              "CREATE_DB               ,"                 ,
              "CREATE_TS               ,"                 ,
              "CREATE_TBL              ,"                 ,
              "CREATE_IX               ,"                 ,
              "CREATE_UNIQUE_IX        ,"                 ,
              "CREATE_VIEW             ,"                 ,
              "CREATE_TRIGGER          ,"                 ,
              "CREATE_ALIAS            ,"                 ,
              "CREATE_SYNONYM          ,"                 ,
              "ALTER_TOTAL             ,"                 ,
              "ALTER_DIVERSE           ,"                 ,
              "ALTER_ADMIN_DROP        ,"                 ,
              "ALTER_COMMENT           ,"                 ,
              "ALTER_LABEL             ,"                 ,
              "DROP_TOTAL              ,"                 ,
              "DROP_DB                 ,"                 ,
              "DROP_TS                 ,"                 ,
              "DROP_TBL                ,"                 ,
              "DROP_INDEX              ,"                 ,
              "DROP_VIEW               ,"                 ,
              "DROP_TRIGGER            ,"                 ,
              "DROP_ALIAS              ,"                 ,
              "DROP_SYNONYM            ,"                 ,
              "TOTAL_CHANGED           )"                 ,
              "VALUES ('"SEARCH_ZS"'    "                 ,
              "       ,"CHANGE_REQUESTS.OUTPUT_COUNT      ,
              "       ,"COMP_NACHTRAEGE.OUTPUT_COUNT      ,
              "       ,"VERS_NACHTRAEGE.OUTPUT_COUNT      ,
              "       ,'"GEBIET.OUTPUT_COUNT"'"           ,
              "       ,'"OUTPUT_APPLID.OUTPUT_COUNT"'"    ,
              "       ,'"OUTPUT_APPLID_DESC.OUTPUT_COUNT"'",
              "       ,"TOTAL_CREATE.OUTPUT_COUNT         ,
              "       ,"CRE_DB_STAT.OUTPUT_COUNT          ,
              "       ,"CRE_TS_STAT.OUTPUT_COUNT          ,
              "       ,"CRE_TBL_STAT.OUTPUT_COUNT         ,
              "       ,"CRE_IX_STAT.OUTPUT_COUNT          ,
              "       ,"CRE_UIX_STAT.OUTPUT_COUNT         ,
              "       ,"CRE_VW_STAT.OUTPUT_COUNT          ,
              "       ,"CRE_TR_STAT.OUTPUT_COUNT          ,
              "       ,"CRE_ALI_STAT.OUTPUT_COUNT         ,
              "       ,"CRE_SYN_STAT.OUTPUT_COUNT         ,
              "       ,"TOTAL_ALTER.OUTPUT_COUNT          ,
              "       ,"ALTER_STAT.OUTPUT_COUNT           ,
              "       ,"ALTER_ADMIN_STAT.OUTPUT_COUNT     ,
              "       ,"COMMENT_STAT.OUTPUT_COUNT         ,
              "       ,"LABEL_STAT.OUTPUT_COUNT           ,
              "       ,"TOTAL_DROP.OUTPUT_COUNT           ,
              "       ,"DROP_DB_STAT.OUTPUT_COUNT         ,
              "       ,"DROP_TS_STAT.OUTPUT_COUNT         ,
              "       ,"DROP_TBL_STAT.OUTPUT_COUNT        ,
              "       ,"DROP_IX_STAT.OUTPUT_COUNT         ,
              "       ,"DROP_VW_STAT.OUTPUT_COUNT         ,
              "       ,"DROP_TR_STAT.OUTPUT_COUNT         ,
              "       ,"DROP_ALI_STAT.OUTPUT_COUNT        ,
              "       ,"DROP_SYN_STAT.OUTPUT_COUNT        ,
              "       ,"FULL_TOTAL.OUTPUT_COUNT           ,
              "       )"
       SQLTEXT = INSERT
       ADDRESS DSNREXX "EXECSQL DECLARE C1 CURSOR FOR S1"
       IF SQLCODE <> 0 THEN CALL SQLCA
       ADDRESS DSNREXX "EXECSQL PREPARE S1 FROM :INSERT"
       IF SQLCODE <> 0 THEN CALL SQLCA
       ADDRESS DSNREXX "EXECSQL EXECUTE S1"
       IF SQLCODE <> 0 THEN CALL SQLCA

       IF OUTPUT_COUNT > 0 & SHOWDETAILS = 'J' THEN DO
          SAY ' '
          SAY 'ZÜGELSCHUB STATISTIKEN FÜR >>> 'GEBIET.OUTPUT_COUNT ' <<<',
              'INSERTED IN TO TABLE TADM12A1|'

          SAY ' '
          SAY ' PRESS "ENTER" TO CONTINUE'
          PULL
       END

   END

   OUTPUT_COUNT = OUTPUT_COUNT + 1

END
RETURN;


/******************************************************************/
SQLCA:
/******************************************************************/
SAY 'SQLCODE =' SQLCODE
SAY 'SQLERRMC=' SQLERRMC
SAY 'SQLERRP =' SQLERRP
SAY 'SQLERRD =' SQLERRD.1',',
                SQLERRD.2',',
                SQLERRD.3',',
                SQLERRD.4',',
                SQLERRD.5',',
                SQLERRD.6
SAY 'WQLWARN='  SQLWARN.0',',
                SQLWARN.1',',
                SQLWARN.2',',
                SQLWARN.3',',
                SQLWARN.4',',
                SQLWARN.5',',
                SQLWARN.6',',
                SQLWARN.7',',
                SQLWARN.8',',
                SQLWARN.9',',
                SQLWARN.10
SAY 'SQLSTATE=' SQLSTATE
SAY 'SQLTEXT =' SQLTEXT
EXIT
RETURN;
----- zSta2 zwischen version|||---------------------------------------*/
/*REXX*/

TRACE 0

ADDRESS ISPEXEC                      /* ISPEXEC-SERVICE ADRESSIEREN*/

ADDRESS TSO 'SUBCOM DSNREXX'               /*HOST CMD ENV AVAILABLE*/
IF RC THEN                                 /*NO, LET'S MAKE ONE*/
S_RC = RXSUBCOM('ADD','DSNREXX','DSNREXX') /*ADD HOST CMD ENV*/
IF RC ^= 0 & RC^= 1 THEN CALL SQLCA(PREPARE DSNREXX)

ORDERFILE = 'DSN.DBX.AUFTRAG'
DDLFILE   = 'DSN.DBX.CDL'
WSLFILE   = 'DSN.DBA.CLON.WSLSRC'
INTENTION = ' '
SEARCH_ZS = 'NO DATE SPECIFIED'
WORKLIST  = 'ALL FOR SPECIFIED MIGRATION-DATE'

ZS_MEMBER = 'N'
MEMBNAME  = ''
ZSMEMBER  = ''
DDLMEMBER = ''
WSLMEMBER = ''
PREVIOUS_MEMBER = ''    /* UM (UNNÖTIGE) DOPPELTE COMPARES OHNE
                           SCHREIBEN EINES CDL MEMBERS AUSZUSCHLIESSEN.
                           STATISTIKEN WÜRDEN SONST VERFÄLSCHT DA
                           DOPPELTE ZÄHLUNG DER DDL CHANGES   */

APPLIDFILE = ''
GEBIETFILE = ''
DESCRFILE  = ''

COLLECT_GEBIET     = 'N'
GEBIET             = ''
GEBIET_VDPS        = ''
GEBIET_COUNT       = 0
GEBIET_PREV        = ''
OUTPUT_APPLID      = ''
OUTPUT_APPLID_DESC = ''

INPUTC = 1
MEMB_C = 1
COUNT  = 1
MEMBER_FOUND = 'N'

CHANGE_REQUESTS.0 = 0
COMP_NACHTRAEGE.0 = 0
VERS_NACHTRAEGE.0 = 0

CRE_DB_STAT.0  = 0
CRE_TS_STAT.0  = 0
CRE_TBL_STAT.0 = 0
CRE_IX_STAT.0  = 0
CRE_UIX_STAT.0 = 0
CRE_VW_STAT.0  = 0
CRE_TR_STAT.0  = 0
CRE_ALI_STAT.0 = 0
CRE_SYN_STAT.0 = 0

ALTER_STAT.0       = 0
ALTER_ADMIN_STAT.0 = 0
COMMENT_STAT.0     = 0
LABEL_STAT.0       = 0

DROP_DB_STAT.0  = 0
DROP_TS_STAT.0  = 0
DROP_TBL_STAT.0 = 0
DROP_IX_STAT.0  = 0
DROP_VW_STAT.0  = 0
DROP_TR_STAT.0  = 0
DROP_ALI_STAT.0 = 0
DROP_SYN_STAT.0 = 0

ADDRESS TSO "CLEAR" /* BILDSCHIRM LÖSCHEN */

CALL READ_APPLID_FILE

SAY 'AN WELCHER AUSWERTUNGSART SIND SIE INTERESSIERT?'
SAY '   -> FUER EINEN OFFIZIELLEN ZUEGELSCHUB - "M" + "ENTER"'
SAY '   -> FUER SPEZIELLE WORKLISTEN          - "S" + "ENTER"'
PULL INTENTION

IF INTENTION <> 'M' & INTENTION <> 'S' THEN DO
   SAY 'FALSCHE EINGABE - PROGRAM WIRD BEENDET...'
   EXIT;
END


/* VERARBEITUNG FÜR INTENTION = M */
IF INTENTION = 'M' THEN DO

   SAY 'FUER WELCHES ZUEGELSCHUBDATUM MOECHTEN SIE IHRE AUSWERTUNGEN'
   SAY 'ERSTELLEN LASSEN? - EINGABE-FORMAT: YYYYMMDD'
   PULL SEARCH_ZS

   IF SEARCH_ZS = ' ' THEN DO
      SAY 'KEIN DATUM EINGEGEBEN - PROGRAM WIRD BEENDET...'
      EXIT;
   END

   SAY 'DETAILS FÜR WORKLISTEN ANZEIGEN?'
   SAY '   -> JA   - "J" + "ENTER"'
   SAY '   -> NEIN - "N" + "ENTER"'
   PULL SHOWDETAILS

   IF SHOWDETAILS <> 'J' & SHOWDETAILS <> 'N' THEN DO
      SAY 'FALSCHE EINGABE - PROGRAM WIRD BEENDET...'
      EXIT;
   END

   ADDRESS TSO "CLEAR" /* BILDSCHIRM LÖSCHEN */

   SAY '   AUFTRAGS-DATEI:' ORDERFILE
   SAY '        DDL-DATEI:' DDLFILE
   SAY '        WSL-DATEI:' WSLFILE
   SAY 'ZUEGELSCHUB-DATUM:' SEARCH_ZS
   SAY '         WORKLIST:' WORKLIST
   SAY ' '

   "LMINIT DATAID(MEMVAR) DATASET('"ORDERFILE"') ENQ(SHR)"
   "LMOPEN DATAID(&MEMVAR) OPTION(INPUT)"

   CALL SEARCH_ZSMEMBER
   "LMFREE DATAID(&MEMVAR)"

   "LMINIT DATAID(MEMVAR) DATASET('"DDLFILE"') ENQ(SHR)"
   "LMOPEN DATAID(&MEMVAR) OPTION(INPUT)"

   CALL COLLECT_DDLFILE_STATS
   "LMFREE DATAID(&MEMVAR)"

   "LMINIT DATAID(MEMVAR) DATASET('"WSLFILE"') ENQ(SHR)"
   "LMOPEN DATAID(&MEMVAR) OPTION(INPUT)"

   CALL COLLECT_WSLFILE_STATS
   "LMFREE DATAID(&MEMVAR)"

   COLLECT_GEBIET = 'Y'

   "LMINIT DATAID(MEMVAR) DATASET('"DDLFILE"') ENQ(SHR)"
   "LMOPEN DATAID(&MEMVAR) OPTION(INPUT)"

   CALL COLLECT_DDLFILE_STATS
   "LMFREE DATAID(&MEMVAR)"

   "LMINIT DATAID(MEMVAR) DATASET('"WSLFILE"') ENQ(SHR)"
   "LMOPEN DATAID(&MEMVAR) OPTION(INPUT)"

   CALL COLLECT_WSLFILE_STATS
   "LMFREE DATAID(&MEMVAR)"

END

/* VERARBEITUNG FÜR INTENTION = S */
IF INTENTION = 'S' THEN DO

   SAY 'FUER WELCHES ZUEGELSCHUBDATUM MOECHTEN SIE IHRE AUSWERTUNGEN'
   SAY 'ERSTELLEN LASSEN? - EINGABE-FORMAT: YYYYMMDD, YYYYMM, YYYY, ...'
   SAY '"ENTER"-TASTE FUER KEIN SPEZIELLES DATUM.'
   PULL SEARCH_ZS

   IF SEARCH_ZS = ' ' THEN DO
      SEARCH_ZS = 'NO DATE SPECIFIED'
   END

   SAY 'BITTE GEBEN SIE IHRE WORKLISTE(N) EIN:'
   SAY 'MEHRERE WORKLISTEN ODER WILDCARDS SIND MOEGLICH.'
   SAY 'EINGABE DURCH DRUECKEN DER "ENTER"-TASTE ABSCHLIESSEN.'
   SAY 'FORMAT: MF01001W, MF01, MF, ...'
   PULL WORKLIST
   WORKLIST.INPUTC = WORKLIST
   DO WHILE WORKLIST <> ' ' /* REPEAT INPUT UNTIL BLANK */
      INPUTC = INPUTC + 1
      PULL WORKLIST
      WORKLIST.INPUTC = WORKLIST
   END

   IF WORKLIST.1 = '' THEN DO
      SAY 'KEINE WORKLISTE SPEZIFIZIERT - PROGRAMM WIRD BEENDET...'
      EXIT;
   END

   SAY 'DETAILS FÜR WORKLISTEN ANZEIGEN?'
   SAY '   -> JA   - "J" + "ENTER"'
   SAY '   -> NEIN - "N" + "ENTER"'
   PULL SHOWDETAILS

   IF SHOWDETAILS <> 'J' & SHOWDETAILS <> 'N' THEN DO
      SAY 'FALSCHE EINGABE - PROGRAM WIRD BEENDET...'
      EXIT;
   END

   ADDRESS TSO "CLEAR" /* BILDSCHIRM LÖSCHEN */

   SAY '  AUFTRAGS-DATEI:' ORDERFILE
   SAY '       DDL-DATEI:' DDLFILE
   SAY '       WSL-DATEI:' WSLFILE
   SAY 'ZUEGELSCHUB-DATUM:' SEARCH_ZS
   SAY '        WORKLIST:' WORKLIST
   SAY ' '
   X = 1
   DO UNTIL X >= INPUTC
      SAY '      WORKLIST:' WORKLIST.X
      X = X + 1
   END
   SAY ' '

   "LMINIT DATAID(MEMVAR) DATASET('"ORDERFILE"') ENQ(SHR)"
   "LMOPEN DATAID(&MEMVAR) OPTION(INPUT)"

   CALL SEARCH_ZSMEMBER
   "LMFREE DATAID(&MEMVAR)"

   "LMINIT DATAID(MEMVAR) DATASET('"DDLFILE"') ENQ(SHR)"
   "LMOPEN DATAID(&MEMVAR) OPTION(INPUT)"

   CALL COLLECT_DDLFILE_STATS
   "LMFREE DATAID(&MEMVAR)"

   "LMINIT DATAID(MEMVAR) DATASET('"WSLFILE"') ENQ(SHR)"
   "LMOPEN DATAID(&MEMVAR) OPTION(INPUT)"

   CALL COLLECT_WSLFILE_STATS
   "LMFREE DATAID(&MEMVAR)"

END

IF MEMBER_FOUND = 'Y' THEN DO
   CALL OUTPUT_STATS
   EXIT;
END

IF MEMBER_FOUND = 'N' THEN DO
   SAY ' '
   SAY 'KEINE DATEN FUER EINGEGEBENE PARAMETER GEFUNDEN|'
   SAY ' '
   SAY '   AUFTRAGS-DATEI:' ORDERFILE
   SAY '        DDL-DATEI:' DDLFILE
   SAY '        WSL-DATEI:' WSLFILE
   SAY 'ZUEGELSCHUB-DATUM:' SEARCH_ZS
   SAY '         WORKLIST:' WORKLIST
   SAY ' '
   SAY 'PROGRAMM WIRD BEENDET...'
   EXIT;
END

/******************************************************************/
READ_APPLID_FILE:
/******************************************************************/

FILECOUNTER = 1

ADDRESS DSNREXX "CONNECT "DBOC
        IF SQLCODE <> 0 THEN CALL SQLCA

SQL_S1="SELECT GEBIETSPOINTER    ",
       "      ,GEBPOINT_BEZEICHNUNG                         ",
       "      ,BANKANWENDUNG                                ",
       "  FROM RZ2DD.TACCT_GEBPOINT;                        "

ADDRESS DSNREXX "EXECSQL DECLARE C1 CURSOR FOR S1 ";
IF (SQLCODE < 0) THEN CALL SQLCA

ADDRESS DSNREXX "EXECSQL PREPARE S1 FROM :SQL_S1 ";
IF (SQLCODE < 0) THEN CALL SQLCA

ADDRESS DSNREXX "EXECSQL OPEN C1 ";
IF (SQLCODE < 0) THEN CALL SQLCA

DO UNTIL (SQLCODE^=0)
   ADDRESS DSNREXX ,
          "EXECSQL FETCH C1 INTO :H0,:H1,:H2"

   GEBIETFILE.FILECOUNTER = H0
   DESCRFILE.FILECOUNTER  = H1
   APPLIDFILE.FILECOUNTER = H2

   FILECOUNTER = FILECOUNTER + 1

END

ADDRESS DSNREXX "DISCONNECT";
IF SQLCODE <> 0 THEN CALL SQLCA

RETURN;

/******************************************************************/
SEARCH_ZSMEMBER:
/******************************************************************/

IF INTENTION = 'M' THEN DO
   DO FOREVER
      "LMMLIST DATAID(&MEMVAR) OPTION(LIST) MEMBER(MEMBNAME)"
      IF RC > 0 THEN LEAVE            /* END OF FILE            */
      CALL READ_MEMB
   END
END

IF INTENTION = 'S' THEN DO
   DO FOREVER
      "LMMLIST DATAID(&MEMVAR) OPTION(LIST) MEMBER(MEMBNAME)"
      IF RC > 0 THEN LEAVE            /* END OF FILE            */

      Y = 1
      DO UNTIL Y > INPUTC
         IF POS(WORKLIST.Y,MEMBNAME) > 0 THEN DO
            CALL READ_MEMB
         END
      Y = Y + 1
      END
   END
END

RETURN;


/******************************************************************/
READ_MEMB:
/******************************************************************/

"LMMFIND DATAID(&MEMVAR) MEMBER("MEMBNAME")"

DO FOREVER
   "LMGET DATAID(&MEMVAR) MODE(INVAR) DATALOC(LINE)
          DATALEN(LINELEN) MAXLEN(160)"
   IF RC > 0 THEN LEAVE            /* END OF FILE                */

   PARSE UPPER VAR LINE V1 V2 V3 V4 V5 V6 V7 V8 V9

   IF INTENTION = 'M' & POS(SEARCH_ZS,V2) > 0 THEN DO
      MEMBER_FOUND = 'Y'
      IF SHOWDETAILS = 'J' THEN DO
         SAY ' '
         SAY MEMBNAME '- AUSZUFUEHREN FUER ZS AM ' V2 ' UM ' V3
      END
      ZS_MEMBER = 'Y'
      GEBIET = SUBSTR(MEMBNAME,1,2)
      GEBIET_VDPS = SUBSTR(MEMBNAME,1,4)

      IF GEBIET <> GEBIET_PREV THEN DO
         GEBIET_COUNT = GEBIET_COUNT + 1
         GEBIET.GEBIET_COUNT = SUBSTR(MEMBNAME,1,2)
         GEBIET_PREV         = SUBSTR(MEMBNAME,1,2)
         /* INIT VARIABLE */
         CHANGE_REQUESTS.GEBIET_COUNT  = 0
         COMP_NACHTRAEGE.GEBIET_COUNT  = 0
         VERS_NACHTRAEGE.GEBIET_COUNT  = 0
         CRE_DB_STAT.GEBIET_COUNT      = 0
         CRE_TS_STAT.GEBIET_COUNT      = 0
         CRE_TBL_STAT.GEBIET_COUNT     = 0
         CRE_IX_STAT.GEBIET_COUNT      = 0
         CRE_UIX_STAT.GEBIET_COUNT     = 0
         CRE_VW_STAT.GEBIET_COUNT      = 0
         CRE_TR_STAT.GEBIET_COUNT      = 0
         CRE_ALI_STAT.GEBIET_COUNT     = 0
         CRE_SYN_STAT.GEBIET_COUNT     = 0
         ALTER_STAT.GEBIET_COUNT       = 0
         ALTER_ADMIN_STAT.GEBIET_COUNT = 0
         COMMENT_STAT.GEBIET_COUNT     = 0
         LABEL_STAT.GEBIET_COUNT       = 0
         DROP_DB_STAT.GEBIET_COUNT     = 0
         DROP_TS_STAT.GEBIET_COUNT     = 0
         DROP_TBL_STAT.GEBIET_COUNT    = 0
         DROP_IX_STAT.GEBIET_COUNT     = 0
         DROP_VW_STAT.GEBIET_COUNT     = 0
         DROP_TR_STAT.GEBIET_COUNT     = 0
         DROP_ALI_STAT.GEBIET_COUNT    = 0
         DROP_SYN_STAT.GEBIET_COUNT    = 0
         /* INIT VARIABLE */
         DO APPLID_CHECK = 1 TO FILECOUNTER
            IF GEBIET_VDPS = 'VDPS' THEN DO
               GEBIET = 'VV'
            END
            IF GEBIET = GEBIETFILE.APPLID_CHECK THEN DO
               OUTPUT_APPLID.GEBIET_COUNT = APPLIDFILE.APPLID_CHECK
               OUTPUT_APPLID_DESC.GEBIET_COUNT = DESCRFILE.APPLID_CHECK
            IF SHOWDETAILS = 'J' THEN DO
               SAY '---> GEBIETSPOINTER:' GEBIET
               SAY '---> APPLICATION-ID:' OUTPUT_APPLID.GEBIET_COUNT
               SAY '--->                ' OUTPUT_APPLID_DESC.GEBIET_COUNT
            END
            END
         END
      END
      IF GEBIET = GEBIET_PREV THEN DO
         GEBIET_PREV = SUBSTR(MEMBNAME,1,2)
         CHANGE_REQUESTS.GEBIET_COUNT = CHANGE_REQUESTS.GEBIET_COUNT + 1
         CHANGE_REQUESTS.0 = CHANGE_REQUESTS.0 + 1
      END
   END

   IF SEARCH_ZS = 'NO DATE SPECIFIED' THEN DO
      IF INTENTION = 'S' & V1 = 'ZUEGELSCHUB' THEN DO
         MEMBER_FOUND = 'Y'
         IF SHOWDETAILS = 'J' THEN DO
            SAY ' '
            SAY MEMBNAME '- AUSZUFUEHREN FUER ZS AM ' V2 ' UM ' V3
         END
         CHANGE_REQUESTS.0 = CHANGE_REQUESTS.0 + 1
         ZS_MEMBER = 'Y'
      END
   END

   IF SEARCH_ZS <> 'NO DATE SPECIFIED' THEN DO
      IF INTENTION = 'S' & POS(SEARCH_ZS,V2) > 0 THEN DO
         MEMBER_FOUND = 'Y'
         IF SHOWDETAILS = 'J' THEN DO
            SAY ' '
            SAY MEMBNAME '- AUSZUFUEHREN FUER ZS AM ' V2 ' UM ' V3
         END
         CHANGE_REQUESTS.0 = CHANGE_REQUESTS.0 + 1
         ZS_MEMBER = 'Y'
      END
   END

   IF V1 = 'COMPARE' & ZS_MEMBER = 'Y' THEN DO
      DDLMEMBER.MEMB_C = SUBSTR(MEMBNAME,1,7) V2
      DDLMEMBER.MEMB_C = SPACE(DDLMEMBER.MEMB_C,0)
      IF SHOWDETAILS = 'J' THEN DO
         SAY MEMBNAME '- COMPARE' V2 'AM' V5 'UM' V6 ,
             ' - DELTA FILE:' DDLMEMBER.MEMB_C
      END
      IF PREVIOUS_MEMBER <> DDLMEMBER.MEMB_C THEN DO
         PREVIOUS_MEMBER = DDLMEMBER.MEMB_C
         MEMB_C = MEMB_C + 1
      END

      IF PREVIOUS_MEMBER = DDLMEMBER.MEMB_C THEN DO
         PREVIOUS_MEMBER = DDLMEMBER.MEMB_C
      END
      COMP_NACHTRAEGE.0 = COMP_NACHTRAEGE.0 + 1
      COMP_NACHTRAEGE.GEBIET_COUNT = COMP_NACHTRAEGE.GEBIET_COUNT + 1
   END

   IF V1 = 'VERSION' & ZS_MEMBER = 'Y' THEN DO
      WSLMEMBER_ORIG = SUBSTR(MEMBNAME,1,7) 'Q'
      IF SHOWDETAILS = 'J' THEN DO
         SAY MEMBNAME '- VERSION' V2 'AM' V5 'UM' V6
      END
      VERS_NACHTRAEGE.0 = VERS_NACHTRAEGE.0 + 1
      VERS_NACHTRAEGE.GEBIET_COUNT = VERS_NACHTRAEGE.GEBIET_COUNT + 1
      VERSION = 'Y'
   END

END

IF ZS_MEMBER = 'Y' & VERSION = 'Y' THEN DO
   WSLMEMBER.COUNT = SUBSTR(MEMBNAME,1,7) 'Q'
   WSLMEMBER.COUNT = SPACE(WSLMEMBER.COUNT,0)
   COUNT = COUNT + 1
END

ZS_MEMBER = 'N'
VERSION = 'N'

RETURN;

/******************************************************************/
COLLECT_DDLFILE_STATS:
/******************************************************************/

MEMBNAME = ""

DO FOREVER
   "LMMLIST DATAID(&MEMVAR) OPTION(LIST) MEMBER(MEMBNAME)"
   IF RC > 0 THEN LEAVE            /* END OF FILE                */

   X = 1
   Y = 1

   DO WHILE X < MEMB_C
      IF MEMBNAME = DDLMEMBER.X & COLLECT_GEBIET = 'N' THEN DO
         S = 0
         CALL READ_DDL_MEMB_DDLFILE
         X = X + 1
      END
      IF MEMBNAME = DDLMEMBER.X & COLLECT_GEBIET = 'Y' THEN DO
         DO WHILE Y < GEBIET_COUNT
            IF SUBSTR(DDLMEMBER.X,1,2) = GEBIET.Y THEN DO
               S = Y
               CALL READ_DDL_MEMB_DDLFILE
            END
         Y = Y + 1
         END
      END
   X = X + 1
   END
END
RETURN;


/******************************************************************/
READ_DDL_MEMB_DDLFILE:
/******************************************************************/

"LMMFIND DATAID(&MEMVAR) MEMBER("MEMBNAME")"

DO FOREVER
   "LMGET DATAID(&MEMVAR) MODE(INVAR) DATALOC(LINE)
          DATALEN(LINELEN) MAXLEN(160)"
   IF RC > 0 THEN LEAVE            /* END OF FILE                */

   PARSE UPPER VAR LINE V1 V2

   IF POS('CREATE',V2) > 0 & POS('DATABASE',V2) > 0 THEN DO
      CRE_DB_STAT.S = CRE_DB_STAT.S + 1
   END

   IF POS('CREATE',V2) > 0 & POS('TABLESPACE',V2) > 0 THEN DO
      CRE_TS_STAT.S = CRE_TS_STAT.S + 1
   END

   IF POS('CREATE',V2) > 0 & POS('TABLE',V2) > 0 &,
      POS('TABLESPACE',V2) = 0 THEN DO
      CRE_TBL_STAT.S = CRE_TBL_STAT.S + 1
   END

   IF POS('CREATE',V2) > 0 & POS('UNIQUE',V2) > 0 &,
      POS('INDEX',V2) > 0 THEN DO
      CRE_UIX_STAT.S = CRE_UIX_STAT.S + 1
   END

   IF POS('CREATE',V2) > 0 & POS('INDEX',V2) > 0 &,
      POS('UNIQUE',V2) = 0 THEN DO
      CRE_IX_STAT.S = CRE_IX_STAT.S + 1
   END

   IF POS('CREATE',V2) > 0 & POS('VIEW',V2) > 0 THEN DO
      CRE_VW_STAT.S = CRE_VW_STAT.S + 1
   END

   IF POS('CREATE',V2) > 0 & POS('TRIGGER',V2) > 0 THEN DO
      CRE_TR_STAT.S = CRE_TR_STAT.S + 1
   END

   IF POS('CREATE',V2) > 0 & POS('ALIAS',V2) > 0 THEN DO
      CRE_ALI_STAT.S = CRE_ALI_STAT.S + 1
   END

   IF POS('CREATE',V2) > 0 & POS('SYNONYM',V2) > 0 THEN DO
      CRE_SYN_STAT.S = CRE_SYN_STAT.S + 1
   END


   IF POS('ALTER',V2) > 0 & POS('ADMIN',V2) = 0,
      & POS('SET DATA TYPE',V2) = 0 THEN DO
      ALTER_STAT.S = ALTER_STAT.S + 1
   END

   IF POS('ADMIN',V2) > 0 & POS('DROP',V2) > 0 THEN DO
      ALTER_ADMIN_STAT.S = ALTER_ADMIN_STAT.S + 1
   END

   IF POS('ALTER',V2) > 0 & POS('SET DATA TYPE',V2) > 0 THEN DO
      ALTER_STAT.S = ALTER_STAT.S
   END


   IF POS('LABEL',V2) > 0 & POS('ON',V2) > 0 THEN DO
      LABEL_STAT.S = LABEL_STAT.S + 1
   END

   IF POS('COMMENT',V2) > 0 & POS('ON',V2) > 0 THEN DO
      COMMENT_STAT.S = COMMENT_STAT.S + 1
   END


   IF POS('DROP',V2) > 0 & POS('DATABASE',V2) > 0 THEN DO
      DROP_DB_STAT.S = DROP_DB_STAT.S + 1
   END

   IF POS('DROP',V2) > 0 & POS('TABLESPACE',V2) > 0 THEN DO
      DROP_TS_STAT.S = DROP_TS_STAT.S + 1
   END

   IF POS('DROP',V2) > 0 & POS('TABLE',V2) > 0 THEN DO
      DROP_TBL_STAT.S = DROP_TBL_STAT.S + 1
   END

   IF POS('DROP',V2) > 0 & POS('INDEX',V2) > 0 THEN DO
      DROP_IX_STAT.S = DROP_IX_STAT.S + 1
   END

   IF POS('DROP',V2) > 0 & POS('VIEW',V2) > 0 THEN DO
      DROP_VW_STAT.S = DROP_VW_STAT.S + 1
   END

   IF POS('DROP',V2) > 0 & POS('VW',V2) > 0 THEN DO
      DROP_VW_STAT.S = DROP_VW_STAT.S + 1
   END

   IF POS('DROP',V2) > 0 & POS('TRIGGER',V2) > 0 THEN DO
      DROP_TR_STAT.S = DROP_TR_STAT.S + 1
   END

   IF POS('DROP',V2) > 0 & POS('ALIAS',V2) > 0 THEN DO
      DROP_ALI_STAT.S = DROP_ALI_STAT.S + 1
   END

   IF POS('DROP',V2) > 0 & POS('SYNONYM',V2) > 0 THEN DO
      DROP_SYN_STAT.S = DROP_SYN_STAT.S + 1
   END

END
RETURN;

/******************************************************************/
COLLECT_WSLFILE_STATS:
/******************************************************************/

MEMBNAME = ' '              /* INITIALISE MEMBNAME */

DO FOREVER
   "LMMLIST DATAID(&MEMVAR) OPTION(LIST) MEMBER(MEMBNAME)"
   IF RC > 0 THEN LEAVE            /* END OF FILE                */

   X = 1
   Y = 1

   DO WHILE X < COUNT
      IF MEMBNAME = WSLMEMBER.X & COLLECT_GEBIET = 'N' THEN DO
         S = 0
         CALL READ_DDL_MEMB_WSLFILE
         X = X + 1
      END
      IF MEMBNAME = WSLMEMBER.X & COLLECT_GEBIET = 'Y' THEN DO
         DO WHILE Y < GEBIET_COUNT
            IF SUBSTR(WSLMEMBER.X,1,2) = GEBIET.Y THEN DO
               S = Y
               CALL READ_DDL_MEMB_WSLFILE
            END
         Y = Y + 1
         END
      END
   X = X + 1
   END
END
RETURN;

/******************************************************************/
READ_DDL_MEMB_WSLFILE:
/******************************************************************/

"LMMFIND DATAID(&MEMVAR) MEMBER("MEMBNAME")"

DO FOREVER
   "LMGET DATAID(&MEMVAR) MODE(INVAR) DATALOC(LINE)
          DATALEN(LINELEN) MAXLEN(80)"
   IF RC > 0 THEN LEAVE            /* END OF FILE                */

   PARSE UPPER VAR LINE V1

   IF POS('CREATE',V1) > 0 & POS('DATABASE',V1) > 0 THEN DO
      CRE_DB_STAT.S = CRE_DB_STAT.S + 1
   END

   IF POS('CREATE',V1) > 0 & POS('TABLESPACE',V1) > 0 THEN DO
      CRE_TS_STAT.S = CRE_TS_STAT.S + 1
   END

   IF POS('CREATE',V1) > 0 & POS('TABLE',V1) > 0 &,
      POS('TABLESPACE',V1) = 0 THEN DO
      CRE_TBL_STAT.S = CRE_TBL_STAT.S + 1
   END

   IF POS('CREATE',V1) > 0 & POS('UNIQUE',V1) > 0 &,
      POS('INDEX',V1) > 0 THEN DO
      CRE_UIX_STAT.S = CRE_UIX_STAT.S + 1
   END

   IF POS('CREATE',V1) > 0 & POS('INDEX',V1) > 0 &,
      POS('UNIQUE',V1) = 0 THEN DO
      CRE_IX_STAT.S = CRE_IX_STAT.S + 1
   END

   IF POS('CREATE',V1) > 0 & POS('VIEW',V1) > 0 THEN DO
      CRE_VW_STAT.S = CRE_VW_STAT.S + 1
   END

   IF POS('CREATE',V1) > 0 & POS('TRIGGER',V1) > 0 THEN DO
      CRE_TR_STAT.S = CRE_TR_STAT.S + 1
   END

   IF POS('CREATE',V1) > 0 & POS('ALIAS',V1) > 0 THEN DO
      CRE_ALI_STAT.S = CRE_ALI_STAT.S + 1
   END

   IF POS('CREATE',V1) > 0 & POS('SYNONYM',V1) > 0 THEN DO
      CRE_SYN_STAT.S = CRE_SYN_STAT.S + 1
   END


   IF POS('ALTER',V1) > 0 & POS('ADMIN',V1) = 0 THEN DO
      ALTER_STAT.S = ALTER_STAT.S + 1
   END

   IF POS('LABEL',V1) > 0 & POS('ON',V1) > 0 THEN DO
      LABEL_STAT.S = LABEL_STAT.S + 1
   END

   IF POS('COMMENT',V1) > 0 & POS('ON',V1) > 0 THEN DO
      COMMENT_STAT.S = COMMENT_STAT.S + 1
   END


   IF POS('DROP',V1) > 0 & POS('DATABASE',V1) > 0 THEN DO
      DROP_DB_STAT.S = DROP_DB_STAT.S + 1
   END

   IF POS('DROP',V1) > 0 & POS('TABLESPACE',V1) > 0 THEN DO
      DROP_TS_STAT.S = DROP_TS_STAT.S + 1
   END

   IF POS('DROP',V1) > 0 & POS('TABLE',V1) > 0 THEN DO
      DROP_TBL_STAT.S = DROP_TBL_STAT.S + 1
   END

   IF POS('DROP',V1) > 0 & POS('INDEX',V1) > 0 THEN DO
      DROP_IX_STAT.S = DROP_IX_STAT.S + 1
   END

   IF POS('DROP',V1) > 0 & POS('VIEW',V1) > 0 THEN DO
      DROP_VW_STAT.S = DROP_VW_STAT.S + 1
   END

   IF POS('DROP',V1) > 0 & POS('TRIGGER',V1) > 0 THEN DO
      DROP_TR_STAT.S = DROP_TR_STAT.S + 1
   END

   IF POS('DROP',V1) > 0 & POS('ALIAS',V1) > 0 THEN DO
      DROP_ALI_STAT.S = DROP_ALI_STAT.S + 1
   END

   IF POS('DROP',V1) > 0 & POS('SYNONYM',V1) > 0 THEN DO
      DROP_SYN_STAT.S = DROP_SYN_STAT.S + 1
   END

END
RETURN;

/******************************************************************/
OUTPUT_STATS:
/******************************************************************/

SAY ' '
SAY ' PRESS "ENTER" TO CONTINUE'
PULL

IF INTENTION = 'M' THEN DO
   ADDRESS DSNREXX "CONNECT "DBAF
           IF SQLCODE <> 0 THEN CALL SQLCA

   DELETE="DELETE FROM OA1A.TADM12A1                                ",
          " WHERE ZUEGELSCHUB = '"SEARCH_ZS"';                      "

   SQLTEXT = DELETE
   ADDRESS DSNREXX "EXECSQL DECLARE C2 CURSOR FOR S2"
   ADDRESS DSNREXX "EXECSQL PREPARE S2 FROM :DELETE"
   ADDRESS DSNREXX "EXECSQL EXECUTE S2"
   ADDRESS DSNREXX "EXECSQL COMMIT"
END

OUTPUT_COUNT = 0

DO WHILE OUTPUT_COUNT <= GEBIET_COUNT

ADDRESS TSO "CLEAR" /* BILDSCHIRM LÖSCHEN */


   TOTAL_CREATE.OUTPUT_COUNT = 0
   TOTAL_CREATE.OUTPUT_COUNT = CRE_DB_STAT.OUTPUT_COUNT,
                             + CRE_TS_STAT.OUTPUT_COUNT,
                             + CRE_TBL_STAT.OUTPUT_COUNT,
                             + CRE_IX_STAT.OUTPUT_COUNT,
                             + CRE_UIX_STAT.OUTPUT_COUNT,
                             + CRE_VW_STAT.OUTPUT_COUNT,
                             + CRE_TR_STAT.OUTPUT_COUNT,
                             + CRE_ALI_STAT.OUTPUT_COUNT,
                             + CRE_SYN_STAT.OUTPUT_COUNT

   TOTAL_ALTER.OUTPUT_COUNT = 0
   TOTAL_ALTER.OUTPUT_COUNT = ALTER_STAT.OUTPUT_COUNT,
                            + ALTER_ADMIN_STAT.OUTPUT_COUNT,
                            + COMMENT_STAT.OUTPUT_COUNT,
                            + LABEL_STAT.OUTPUT_COUNT

   TOTAL_DROP.OUTPUT_COUNT = 0
   TOTAL_DROP.OUTPUT_COUNT = DROP_DB_STAT.OUTPUT_COUNT,
                           + DROP_TS_STAT.OUTPUT_COUNT,
                           + DROP_TBL_STAT.OUTPUT_COUNT,
                           + DROP_IX_STAT.OUTPUT_COUNT,
                           + DROP_VW_STAT.OUTPUT_COUNT,
                           + DROP_TR_STAT.OUTPUT_COUNT,
                           + DROP_ALI_STAT.OUTPUT_COUNT,
                           + DROP_SYN_STAT.OUTPUT_COUNT

   FULL_TOTAL.OUTPUT_COUNT = 0
   FULL_TOTAL.OUTPUT_COUNT = TOTAL_CREATE.OUTPUT_COUNT,
                           + TOTAL_ALTER.OUTPUT_COUNT,
                           + TOTAL_DROP.OUTPUT_COUNT

   IF OUTPUT_COUNT = 0 THEN DO
      SAY ' G E S A M T   S T A T I S T I K  -' SEARCH_ZS
      SAY '    TOTAL AUFTRAEGE...........' CHANGE_REQUESTS.OUTPUT_COUNT
      SAY '    TOTAL COMPARES (V7.2 NEU).' COMP_NACHTRAEGE.OUTPUT_COUNT
      SAY '    TOTAL VERSIONS (V7.2 ALT).' VERS_NACHTRAEGE.OUTPUT_COUNT,
          '    NACHTRAEGE.' COMP_NACHTRAEGE.OUTPUT_COUNT +,
                            VERS_NACHTRAEGE.OUTPUT_COUNT -,
                            CHANGE_REQUESTS.OUTPUT_COUNT
      SAY ' '
   END

   IF OUTPUT_COUNT > 0 THEN DO
      IF SUBSTR(OUTPUT_APPLID.OUTPUT_COUNT,1,6) = 'OUTPUT' THEN DO
         OUTPUT_APPLID.OUTPUT_COUNT = 'NA'
         OUTPUT_APPLID_DESC.OUTPUT_COUNT = 'NA'
      END

      IF SHOWDETAILS = 'J' THEN DO
         SAY ' S T A T I S T I K   ' SEARCH_ZS,
             ' G E B I E T S P O I N T E R   ' GEBIET.OUTPUT_COUNT
         SAY ' A P P L - I D   ' OUTPUT_APPLID.OUTPUT_COUNT '-',
                                 OUTPUT_APPLID_DESC.OUTPUT_COUNT
         SAY ' '
      END
   END

   IF SHOWDETAILS = 'J' | OUTPUT_COUNT = 0 THEN DO

   SAY ' C R E A T E   D B 2   O B J E C T S'
   SAY '    TOTAL CREATE..........' TOTAL_CREATE.OUTPUT_COUNT
   SAY ' '
   SAY '    CREATE DATABASE.......' CRE_DB_STAT.OUTPUT_COUNT
   SAY '    CREATE TABLESPACE.....' CRE_TS_STAT.OUTPUT_COUNT
   SAY '    CREATE TABLE..........' CRE_TBL_STAT.OUTPUT_COUNT
   SAY '    CREATE INDEX..........' CRE_IX_STAT.OUTPUT_COUNT
   SAY '    CREATE UNIQUE INDEX...' CRE_UIX_STAT.OUTPUT_COUNT
   SAY '    CREATE VIEW...........' CRE_VW_STAT.OUTPUT_COUNT
   SAY '    CREATE TRIGGER........' CRE_TR_STAT.OUTPUT_COUNT
   SAY '    CREATE ALIAS..........' CRE_ALI_STAT.OUTPUT_COUNT
   SAY '    CREATE SYNONYM........' CRE_SYN_STAT.OUTPUT_COUNT
   SAY ' '
   SAY ' A L T E R   D B 2   O B J E C T S'
   SAY '    TOTAL ALTER...........' TOTAL_ALTER.OUTPUT_COUNT
   SAY ' '
   SAY '    DIVERSE ALTER.........' ALTER_STAT.OUTPUT_COUNT
   SAY '    ADMIN ALTER (=DROP)...' ALTER_ADMIN_STAT.OUTPUT_COUNT
   SAY '    COMMENT ON............' COMMENT_STAT.OUTPUT_COUNT
   SAY '    LABEL ON..............' LABEL_STAT.OUTPUT_COUNT
   SAY ' '
   SAY ' D R O P   D B 2   O B J E C T S'
   SAY '    TOTAL DROP............' TOTAL_DROP.OUTPUT_COUNT
   SAY ' '
   SAY '    DROP DATABASE.........' DROP_DB_STAT.OUTPUT_COUNT
   SAY '    DROP TABLESPACE.......' DROP_TS_STAT.OUTPUT_COUNT
   SAY '    DROP TABLE............' DROP_TBL_STAT.OUTPUT_COUNT
   SAY '    DROP INDEX............' DROP_IX_STAT.OUTPUT_COUNT
   SAY '    DROP VIEW.............' DROP_VW_STAT.OUTPUT_COUNT
   SAY '    DROP TRIGGER..........' DROP_TR_STAT.OUTPUT_COUNT
   SAY '    DROP ALIAS............' DROP_ALI_STAT.OUTPUT_COUNT
   SAY '    DROP SYNONYM..........' DROP_SYN_STAT.OUTPUT_COUNT
   SAY ' ===================================='
   SAY '    TOTAL CHANGED.........' FULL_TOTAL.OUTPUT_COUNT

   IF OUTPUT_COUNT = 0 THEN DO
      SAY ' '
      SAY ' PRESS "ENTER" TO CONTINUE'
      PULL
   END

   END


   IF OUTPUT_COUNT > 0 THEN DO

      ADDRESS DSNREXX "CONNECT "DBAF
              IF SQLCODE <> 0 THEN CALL SQLCA

      INSERT= "INSERT INTO OA1A.TADM12A1 ( "              ,
              "ZUEGELSCHUB             ,"                 ,
              "CHANGE_REQ              ,"                 ,
              "COMPARES                ,"                 ,
              "VERSIONS                ,"                 ,
              "GEBIETSPOINTER          ,"                 ,
              "APPLID                  ,"                 ,
              "APPLID_DESC             ,"                 ,
              "CREATE_TOTAL            ,"                 ,
              "CREATE_DB               ,"                 ,
              "CREATE_TS               ,"                 ,
              "CREATE_TBL              ,"                 ,
              "CREATE_IX               ,"                 ,
              "CREATE_UNIQUE_IX        ,"                 ,
              "CREATE_VIEW             ,"                 ,
              "CREATE_TRIGGER          ,"                 ,
              "CREATE_ALIAS            ,"                 ,
              "CREATE_SYNONYM          ,"                 ,
              "ALTER_TOTAL             ,"                 ,
              "ALTER_DIVERSE           ,"                 ,
              "ALTER_ADMIN_DROP        ,"                 ,
              "ALTER_COMMENT           ,"                 ,
              "ALTER_LABEL             ,"                 ,
              "DROP_TOTAL              ,"                 ,
              "DROP_DB                 ,"                 ,
              "DROP_TS                 ,"                 ,
              "DROP_TBL                ,"                 ,
              "DROP_INDEX              ,"                 ,
              "DROP_VIEW               ,"                 ,
              "DROP_TRIGGER            ,"                 ,
              "DROP_ALIAS              ,"                 ,
              "DROP_SYNONYM            ,"                 ,
              "TOTAL_CHANGED           )"                 ,
              "VALUES ('"SEARCH_ZS"'    "                 ,
              "       ,"CHANGE_REQUESTS.OUTPUT_COUNT      ,
              "       ,"COMP_NACHTRAEGE.OUTPUT_COUNT      ,
              "       ,"VERS_NACHTRAEGE.OUTPUT_COUNT      ,
              "       ,'"GEBIET.OUTPUT_COUNT"'"           ,
              "       ,'"OUTPUT_APPLID.OUTPUT_COUNT"'"    ,
              "       ,'"OUTPUT_APPLID_DESC.OUTPUT_COUNT"'",
              "       ,"TOTAL_CREATE.OUTPUT_COUNT         ,
              "       ,"CRE_DB_STAT.OUTPUT_COUNT          ,
              "       ,"CRE_TS_STAT.OUTPUT_COUNT          ,
              "       ,"CRE_TBL_STAT.OUTPUT_COUNT         ,
              "       ,"CRE_IX_STAT.OUTPUT_COUNT          ,
              "       ,"CRE_UIX_STAT.OUTPUT_COUNT         ,
              "       ,"CRE_VW_STAT.OUTPUT_COUNT          ,
              "       ,"CRE_TR_STAT.OUTPUT_COUNT          ,
              "       ,"CRE_ALI_STAT.OUTPUT_COUNT         ,
              "       ,"CRE_SYN_STAT.OUTPUT_COUNT         ,
              "       ,"TOTAL_ALTER.OUTPUT_COUNT          ,
              "       ,"ALTER_STAT.OUTPUT_COUNT           ,
              "       ,"ALTER_ADMIN_STAT.OUTPUT_COUNT     ,
              "       ,"COMMENT_STAT.OUTPUT_COUNT         ,
              "       ,"LABEL_STAT.OUTPUT_COUNT           ,
              "       ,"TOTAL_DROP.OUTPUT_COUNT           ,
              "       ,"DROP_DB_STAT.OUTPUT_COUNT         ,
              "       ,"DROP_TS_STAT.OUTPUT_COUNT         ,
              "       ,"DROP_TBL_STAT.OUTPUT_COUNT        ,
              "       ,"DROP_IX_STAT.OUTPUT_COUNT         ,
              "       ,"DROP_VW_STAT.OUTPUT_COUNT         ,
              "       ,"DROP_TR_STAT.OUTPUT_COUNT         ,
              "       ,"DROP_ALI_STAT.OUTPUT_COUNT        ,
              "       ,"DROP_SYN_STAT.OUTPUT_COUNT        ,
              "       ,"FULL_TOTAL.OUTPUT_COUNT           ,
              "       )"
       SQLTEXT = INSERT
       ADDRESS DSNREXX "EXECSQL DECLARE C1 CURSOR FOR S1"
       IF SQLCODE <> 0 THEN CALL SQLCA
       ADDRESS DSNREXX "EXECSQL PREPARE S1 FROM :INSERT"
       IF SQLCODE <> 0 THEN CALL SQLCA
       ADDRESS DSNREXX "EXECSQL EXECUTE S1"
       IF SQLCODE <> 0 THEN CALL SQLCA

       IF OUTPUT_COUNT > 0 & SHOWDETAILS = 'J' THEN DO
          SAY ' '
          SAY 'ZÜGELSCHUB STATISTIKEN FÜR >>> 'GEBIET.OUTPUT_COUNT ' <<<',
              'INSERTED IN TO TABLE TADM12A1|'

          SAY ' '
          SAY ' PRESS "ENTER" TO CONTINUE'
          PULL
       END

   END

   OUTPUT_COUNT = OUTPUT_COUNT + 1

END
RETURN;


/******************************************************************/
SQLCA:
/******************************************************************/
SAY 'SQLCODE =' SQLCODE
SAY 'SQLERRMC=' SQLERRMC
SAY 'SQLERRP =' SQLERRP
SAY 'SQLERRD =' SQLERRD.1',',
                SQLERRD.2',',
                SQLERRD.3',',
                SQLERRD.4',',
                SQLERRD.5',',
                SQLERRD.6
SAY 'WQLWARN='  SQLWARN.0',',
                SQLWARN.1',',
                SQLWARN.2',',
                SQLWARN.3',',
                SQLWARN.4',',
                SQLWARN.5',',
                SQLWARN.6',',
                SQLWARN.7',',
                SQLWARN.8',',
                SQLWARN.9',',
                SQLWARN.10
SAY 'SQLSTATE=' SQLSTATE
SAY 'SQLTEXT =' SQLTEXT
EXIT
RETURN;