zOs/WK/PKGUSLS3

$#@
$=dsn=A540769.wk.texw(pkgusLs2)
m.cnt.lusSel = 0
m.cnt.lusFnd = 0
m.cfg.cutoff = '2012-01-17'
m.cfg.p.cutoff = '2011-11-01'
m.lusLim.RZ2.1 = '2011-09-30'
m.lusLim.RZ2.2 = '-'
m.lusLim.RR2.1 = '2011-11-31'
m.lusLim.RR2.2 = '-'
m.lusLim.RZ1.1 = '2012-01-20'
m.lusLim.RZ1.2 = '2011-01-01'
m.checkLus = 1
m.useWW = 'RZ2 RR2 RZ1'
m.sysWW = 'P   Q   CDEAT'
if m.checkLus then do
    call sqlConnect DBOC
    do wx=1 to words(m.useWW)
        call sqlPreDeclare wx,
            , "select value(char(max(lastUsed), iso), '-')" ,
                 "from" word(m.useWW, wx)".TACCT_PKGUSED" ,
                 "where PCK_ID = ? and PCK_CONSIST_TOKEN = ?"
        end
    end
$;
call readDsn $dsn, 'M.INP.'
say m.inp.0 'recs in' $dsn
m.cur.marA = ''
$@do ix=1     to  m.inp.0 $@[
    parse var m.inp.ix mark cpv ,
                     'cre:' cre 'con:' con 'pct:' pct 'lus:' lus
    if abbrev(mark, '*') | abbrev(mark, '+') then
        iterate
    cpv = strip(cpv)
    if ix // 1000 = 0 then
        say '...' ix elong(cpv, 35) time()
    parse var cpv cp '(' vers ')'
    cp = strip(cp)
    vers = strip(vers)
    parse var cp col '.' pkg
    do wx=1 to 3
        m.lu.wx = '-'
        end
    do wx = 1
        parse value word(lus, wx) with p '=' l1
        if p == '' & l1 == '' then
            leave
        px = wordPos(p, m.useWW)
        if px < 1 then
            call err 'bad lus' l1 'in' ix':' m.inp.ix
        m.lu.px = l1
        end
    cAll = ''
    do wx = 1
        parse value word(con, wx) with p '=' c1
        if p == '' & c1 == '' then
            leave
        if wordPos(c1, cAll) > 0 then
            iterate
        cAll = cAll c1
        do ux=1 to words(m.useWW)
            if verify(mark, word(m.sysWW, ux), 'm') < 1 then
                iterate
            if sqlOpAllCl(ux, st, ':cLus', pkg, c1) <> 1 then
                call err m.st.0 'rows'
            if cLus \== '-' & (m.lu.ux == '-' | cLus >> m.lu.ux) then
                say cpv c1 'cLus' cLus '>' m.lu.ux word(m.useWW, ux)
            end
        end
    $]
$#end
    if cp \== cpLast then do
        if m.cur.marA \== '' then
            $@doCP()
        m.cur.marA = ''
        m.cur.keep = ''
        m.cur.keep.1 = ''
        m.cur.keep.2 = ''
        cpLast = cp
        end
    if m.addLus then do
        $=lus =- ''
        if pos('P', mark) > 0 then
             $@lastUsed-{pkg, 'P', con, ix, 'RZ2'}
        if pos('Q', mark) > 0 then
             $@lastUsed-{pkg, 'Q', con, ix, 'RR2'}
        mar1 = space(translate(mark, '   ', 'PQ+'), 0)
        if mar1 \== '' then
             $@lastUsed-{pkg, mar1, con, ix, 'RZ1'}
        lus = $lus
        m.inp.ix = elong(mark, 9) cpv ,
                     'cre:' cre 'con:' con 'pct:' pct 'lus:' lus
        end
    do mx=1 to length(mark)
        m1 = substr(mark, mx, 1)
        if pos(m1, m.cur.marA) < 1 then do
            m.cur.marA = m.cur.marA || m1
            m.cur.m1.last = ''
            if symbol('m.cfg.m1.cutoff') \== 'VAR' then
                m.cfg.m1.cutoff = m.cfg.cutoff
            end
        cx = pos(m1'=', cre)
        if cx < 1 then
            call err 'cre:' m1'= missing in line' ix 'cre:' cre
        c1 = word(substr(cre, cx+2, 40), 1)
        if c1 >>= m.cfg.m1.cutoff then do
            if wordPos(ix, m.cur.keep) < 1 then
                m.cur.keep = m.cur.keep ix
            end
        else if c1 >> m.cur.m1.last then do
            m.cur.m1.last = c1 ix
            end
        end
    px = pos('=', lus)
    do while px > 0
        r1 = substr(lus, px-3, 3)
        u1 = word(substr(lus,px+1, 40), 1)
        if wordpos(r1, m.useWW) < 0 then
            call err 'bad lastUsed' r1 'in' ix':' lus
        px = pos('=', lus, px+1)
        do lx=1 to 2
            if m.lusLim.r1.lx == '-' ,
                | (u1 \== '-' & u1 >>= m.lusLim.r1.lx) then
                 if wordPos(ix, m.cur.keep.lx) < 1 then
                     m.cur.keep.lx = m.cur.keep.lx ix
            end
        end
    end
if m.cur.marA \== '' then
    $@doCP()
say 'ending   out'
call writeDsn $dsO, 'M.INP.', , 1
if m.addLus then
    call sqlDisconnect
$@proc doCP $@[
                /* keep last before limit */
    do mx=1 to length(m.cur.marA)
        m1 = substr(m.cur.marA, mx, 1)
        if m.cur.m1.last \== '' then
            parse var m.cur.m1.last tst ix
            if wordPos(ix, m.cur.keep) < 1 &  m.cur.keep.2 \== '' then
                m.cur.keep = m.cur.keep ix
        end
    do wx=1
        ix = word(m.cur.keep, wx)
        if ix = '' then
            leave
        parse var m.inp.ix old rst
        if pos('+', old) < 1 then
            m.inp.ix = elong('+'old, 9) strip(rst)
        end
    do wx=1
        ix = word(m.cur.keep.1, wx)
        if ix == '' then
            leave
        if wordPos(ix, m.cur.keep) >= 1 then
            iterate
        say '?keep.1 missing' ix
        parse var m.inp.ix old rst
        if pos('?', old) < 1 then
            m.inp.ix = elong('?'old, 9) strip(rst)
        end
$]
$@proc lastUsed $@[
    parse arg , pkg, mN, con, ix, cr
    curx = wordPos(cr, m.lusCur)
    if curx < 1 then do
        m.lusCur = m.lusCur cr
        curx = wordPos(cr, m.lusCur)
        call sqlPreDeclare curx,
            , "select value(char(max(lastUsed), iso), '-')" ,
                 "from" cr".TACCT_PKGUSED" ,
                 "where PCK_ID = ? and PCK_CONSIST_TOKEN = ?"
        end
    allTok = ''
    lusMax = '-'
    do mx=1 to length(mN)
        m1 = substr(mN, mx, 1)
        px = pos(m1'=', con)
        if px < 1 then
           call err 'no contoken' m1'= in' ix':'m.inp.ix
        c1 = word(substr(con, px+2, 30), 1)
        if wordPos(c1, allTok) >= 1 then
            iterate
        allTok = allTok c1
        if symbol('m.pkgTok.cr.pkg.c1') == 'VAR' then do
            lus1 = m.pkgTok.cr.pkg.c1
            m.cnt.lusFnd = m.cnt.lusFnd + 1
            end
        else do
            call sqlOpAllCl curx, lui, ':lus1', pkg, c1
            m.pkgTok.cr.pkg.c1 = lus1
            m.cnt.lusSel = m.cnt.lusSel + 1
            end
        if lus1 >> lusMax then
            lusMax = lus1
        end
    $=lus=- $lus cr'='lusMax
 /* say pkg wh allTok 'in' mN cr 'lastUsed' lusMax  */
$]
$#out                                              20120511 13:39:19
$#out                                              20120405 08:15:28
$#out                                              20120405 08:01:35
*** run error ***
SQLCODE = -313: THE NUMBER OF HOST VARIABLES SPECIFIED IS
    NOT EQUAL TO THE NUMBER OF PARAMETER MARKERS
stmt = open c1
$#out                                              20120305 17:04:26
$#out                                              20120211 14:09:11
$#out                                              20120211 14:06:22
$#out                                              20120211 13:54:27