zOs/SQL/XBUNL

//A540769X JOB (CP00,KE50),'DB2 REO',                                   00010000
//         MSGCLASS=T,TIME=1440,                                        00020000
//         NOTIFY=&SYSUID,REGION=0M,                                    00030000
//         SCHENV=DB2,CLASS=M1                                          00040000
//*
//S1       EXEC PGM=IKJEFT01,DYNAMNBR=200,TIME=99,                      00020001
//             PARM='%WSH'
//*           PARM='%WSH t all all'
//SYSPROC   DD DSN=DSN.DB2.EXEC,DISP=SHR
//SYSPRINT  DD SYSOUT=*
//SYSUDUMP  DD SYSOUT=*
//SYSTSPRT  DD SYSOUT=*
//SYSTSIN   DD DUMMY
//OUT       DD DISP=SHR,DSN=A540769.WK.TEXW(XBUNL2)
//WSH       DD *
$#@
$=mode= 1
if $mode == 1 then $@:[
    stagePred = stage <> '-w'
    uPref     = XB.
    uMask     = XB.XB*.**
$]  else if $mode == 2 then $@:[
    stagePred = stage =  '-w'
    uPref     = XB.MIG.U.
    uMask     = XB.MIG.U
    $]
say 'mode='$mode 'stagePred' $stagePred 'unlPref' $uPref
$= p2 =- length($uPref)
$= l2 =- length($uPref) + 18
call csiOpen csi, $uMask
$=cx=0
$<>
$<=[
select *
    from OA1P.TQZ005TECSVUNLOAD
    where pa > 0 and unl <> ''
        and $stagePred
    order by cast(db || '.' || ts as char(17) ccsid ebcdic), pa
$]
call sqlConnect dvbp
call sqlQuery 3, in2str()
$=fx=0
$<>
$@csi
$@fet
m.punKeep = ''
$do lx=1 to 1e99 while m.cc \== '' & m.ff.db \== 'ff'x $@[
    if $cDb = m.ff.db then
        if $cTs = m.ff.ts then
            if $cPa = m.ff.pa then
                cmp = 1
            else
                cmp = 2 * ($cPa > m.ff.pa)
        else
            cmp = 2 * ($cTs > m.ff.ts)
    else
        cmp = 2 * ($cDb > m.ff.db)
    cmp = cmp - 1
    if lx // 1000 = 0 then
        say right(cmp, 2) 'c'$cx $cDb $cTs $cPa,
           '<=> f'$fx m.ff.db m.ff.ts m.ff.pa 'pun' m.punKeep
    if cmp == -1 then $@[
        $$- 'dsn not in stageTable' m.cc m.punKeep
        m.punKeep = ''
    $] else if cmp == 1 then $@[
        $$- 'missing unl for stage' m.ff.unl m.ff.pun $*+
            m.ff.stage m.ff.db'.'m.ff.ts'#'m.ff.pa
    $] else if cmp == 0 then $@[
        px = wordPos(strip(m.ff.pun), m.punKeep)
        if px < 1 then
            $$- 'punch not found      ' m.ff.pun 'keep' m.punKeep
        else
            m.punKeep = strip(delWord(m.punKeep, px, 1))
        if m.punKeep <> '' then
            $$- 'punch not in stage   ' m.ff.unl m.punKeep
        m.punKeep = ''
        $]
    if cmp <= 0 then
        $@csi
    if cmp >= 0 then
        $@fet
    $]

$proc $@/csi/
    $do while csiNext(csi, cc) $@[
        $=cx=- $cx + 1
        if \ abbrev(m.cc, $uPref) then
            call err 'unload does not start with uPref' m.cc
        xTs = pos('.', m.cc, $p2+1)
        xPa = pos('.', m.cc, xTs+1)
        xNx = pos('.', m.cc, xPa+1)
        if xTs <= 0 | xPa <= 0 | xNx <= 0 then
             er = 'bad unload missing dots' m.cc
        else if substr(m.cc, xPa, 2) \== '.P' then
             er = 'bad unload bad part' m.cc
        else do
            yPa = substr(m.cc, xPa+2, xNx-xPa-2)
            if \ dataType(yPa, 'n') then
                yPa = substr(yPa, 2)
            if dataType(yPa, 'n') then
                er = ''
            else
                er = 'bad unload bad part not numeric' m.cc
            end
        if er <> '' then do
            $$- er
            iterate
            end
        if substr(m.cc, xNx) = '.SYSPCH' then do
            m.punKeep = m.punKeep m.cc
            iterate
            end
        $= cDb =- substr(m.cc, $p2+ 1, xTs-$p2-1)
        $= cTs =- substr(m.cc, xTs+1, xPa-xTs-1)
        $= cPa =- yPa
        return
    $]
    m.cc = ''
    $= cDb =- 'ff'x
$/csi/

$proc $@/fet/
    if sqlFetch(3, ff) then
        $=fx=- $fx + 1
    else
        m.ff.db = 'ff'x
$/fet/