zOs/WK/PKGUSLS2

$#@
$=dsI=A540769.wk.texw(pkgUsLst)
$=dsO=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.addLus = 1
if m.addLus then
    call sqlConnect DBOC
$;
call readDsn $dsI, 'M.INP.'
say m.inp.0 'recs in' $dsI
m.cur.marA = ''
m.useWW = 'RZ2 RR2 RZ1'
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, '*') then
        iterate
    cpv = strip(cpv)
    if ix // 1000 = 0 then
        say '...' ix elong(cpv, 35) time() 'lusSel' m.cnt.lusSel ,
                                           'lusFnd' m.cnt.lusFnd
    parse var cpv cp '(' vers ')'
    cp = strip(cp)
    vers = strip(vers)
    parse var cp col '.' pkg
    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                                              20120125 17:11:10
$#out                                              20120125 17:05:40
$#out                                              20120125 17:01:05
$#out                                              20120125 16:57:19
$#out                                              20120125 16:55:48
$#out                                              20120125 15:39:20
$#out                                              20120125 13:53:50
$#out                                              20120125 12:24:35
$#out                                              20120125 12:18:12
$#out                                              20120125 11:57:52
$#out                                              20120125 11:48:42
$#out                                              20120125 11:36:57
$#out                                              20120124 17:29:36
$#out                                              20120124 16:43:32