XBPATSE ; IHS/ADC/GTH - SEARCH ROUTINES FOR PATCHES ; [ 10/29/2002 7:42 AM ]
;;3.0;IHS/VA UTILITIES;**9**;FEB 07, 1997
; XB*3*9 IHS/SET/GTH XB*3*9 10/29/2002 Cache' mods.
;
; Search Routines for Patch Versions.
;
; Thanks to Ray A. Willie for the original routine.
;
MAIN ;
NEW XB,DUZ,IO,IOF,IOM,IOSL,IOBS,IOXY,IOST,DT,DTIME,POP,U,X,Y
D INIT
D:'$D(ZTQUEUED)
. D RSEL
. D:'XB("END") DEVICE
.Q
D:'XB("END") SRCH
D:'XB("END") PRT
D EXIT
Q
;
INIT ;
S (XB("END"),XB("VER"),XB("PNBR"),XB("Q"))=0,XB("NAM")=""
KILL ^TMP($J)
D:'$D(ZTQUEUED) ^XBKVAR,DT^DICRW,HOME^%ZIS
D NOW^%DTC
S Y=%
X ^DD("DD")
S XB("DT")=Y
X ^%ZOSF("UCI")
S XB("UCI")=$P(Y,","),XB("VOL")=$P(Y,",",2)
S XB("HD1")="R.P.M.S. PATCH SEARCH UTILITY Version: "_$P($T(+2),";",3)
S XB("HD2")="UCI: "_XB("UCI")_" CPU: "_XB("VOL")_" "_XB("DT")
Q
;
RSEL ;
D SCHDR
X ^%ZOSF("RSEL")
S XB("END")='$D(^UTILITY($J))
Q
;
DEVICE ;
NEW %ZIS
S %ZIS="NMQ"
D ^%ZIS
S XB("END")=POP
Q:XB("END")
S XB("IOP")=ION_";"_IOST_$S($D(IO("DOC")):";"_IO("DOC"),1:";"_IOM_";"_IOSL)
D:$D(IO("Q")) QUE
Q
;
QUE ;
NEW ZTRTN,ZTIO,ZTDESC,ZTSAVE,ZTSK
D:IO=IO(0)&($E(IOST,1,2)="C-")&($D(IO("Q"))#2)
. W !,"Cannot Queue to HOME or CHARACTER Device",!
. S XB("END")=1
.Q
Q:XB("END")
S ZTRTN="^"_$TR($P($T(+1),";")," ",""),ZTIO=XB("IOP"),ZTDESC=$P($T(+1),";",2)
F Q:$E(ZTDESC)'=" " S ZTDESC=$E(ZTDESC,2,99)
S ZTSAVE("^UTILITY($J,")=""
D ^%ZTLOAD
I '$D(ZTSK) W !,"TASK not Queued with Task Manager",! S XB("END")=1
Q:XB("END")
S %H=ZTSK("D")
D YX^%DTC
W !,"TASK Queued with Task Manager: JOB # ",ZTSK," at ",Y,!
D HOME^%ZIS
S XB("END")=1
Q
;
SRCH ;
NEW XCNP,DIF
D:'$D(ZTQUEUED) SCHDR
S XB("NSP")=""
F S XB("NSP")=$O(^DIC(9.4,"C",XB("NSP"))) Q:XB("NSP")="" D
. S XB("EIN")=0,XB("EIN")=$O(^DIC(9.4,"C",XB("NSP"),XB("EIN")))
. S XB("NAM")=$P($G(^DIC(9.4,XB("EIN"),0)),U)
. S XB("VER")=$G(^DIC(9.4,XB("EIN"),"VERSION"),0)
. S XB("ROU")=XB("NSP")
. S:$D(^UTILITY($J,XB("ROU"))) XB("ROU")=$O(^UTILITY($J,XB("ROU")),-1)
. F XB("RKT")=0:1 S XB("ROU")=$O(^UTILITY($J,XB("ROU"))) Q:$E(XB("ROU"),1,$L(XB("NSP")))'=XB("NSP") D SRCH1
. D:XB("RKT")>0 SRCH2
.Q
;S XB("NSP")="~~",XB("ROU")="";IHS/SET/GTH XB*3*9 10/29/2002
S XB("NSP")="~~",XB("ROU")=0 ;IHS/SET/GTH XB*3*9 10/29/2002
F XB("RKT")=0:1 S XB("ROU")=$O(^UTILITY($J,XB("ROU"))) Q:XB("ROU")="" D
. S XB("NAM")="",XB("VER")=0
. D SRCH1
.Q
S XB("NAM")="%",XB("VER")=0
D:XB("RKT")>0 SRCH2
Q
;
SRCH1 ;
D:'$D(ZTQUEUED)
. W:'(XB("RKT")#8) !
. W XB("ROU"),$J("",9-$L(XB("ROU")))
.Q
S XCNP=0,DIF="^TMP("_$J_",""R"","""_XB("ROU")_""",",X=XB("ROU")
X ^%ZOSF("TEST")
Q:'$T
X ^%ZOSF("LOAD")
S XB("PPC")=$TR($P($G(^TMP($J,"R",XB("ROU"),2,0)),";",5),"*","")
D:XB("PPC")]""&(XB("PPC")'=0)
. S:XB("NAM")="" XB("NAM")=$P($G(^TMP($J,"R",XB("ROU"),2,0)),";",4)
. S:XB("VER")=0 XB("VER")=$P($G(^TMP($J,"R",XB("ROU"),2,0)),";",3)
. S XB("DESC")=$S($P($P($G(^TMP($J,"R",XB("ROU"),1,0)),";",2),"-",2,3)'="":$P($P($G(^TMP($J,"R",XB("ROU"),1,0)),";",2),"-",2,3),1:$P($G(^TMP($J,"R",XB("ROU"),1,0)),";",3))
. F Q:$E(XB("DESC"))'=" " S XB("DESC")=$E(XB("DESC"),2,99)
. D:XB("VER")]""&(XB("NAM")]"")
.. F XB("J")=1:1 S XB("PNR")=$P(XB("PPC"),",",XB("J")) Q:XB("PNR")="" D:XB("PNR")?1.4N
... S ^TMP($J,"P",XB("NSP"),XB("NAM"),XB("VER"),XB("PNR"),XB("ROU"))=XB("DESC")
... S ^TMP($J,"P","P",XB("PNR"))=""
... S ^TMP($J,"P","R",XB("ROU"))=""
KILL ^TMP($J,"R",XB("ROU")),^UTILITY($J,XB("ROU"))
Q
;
SRCH2 ;
W:'$D(ZTQUEUED) !!?5,XB("RKT")," Routines Processed",!!
S (XB("PNR"),XB("ROU"))=""
F XB("PKT")=0:1 S XB("PNR")=$O(^TMP($J,"P","P",XB("PNR"))) Q:XB("PNR")=""
F XB("PRK")=0:1 S XB("ROU")=$O(^TMP($J,"P","R",XB("ROU"))) Q:XB("ROU")=""
KILL ^TMP($J,"P","P"),^TMP($J,"P","R")
S ^TMP($J,"P",XB("NSP"),XB("NAM"),XB("VER"),.01)=XB("RKT")
S ^TMP($J,"P",XB("NSP"),XB("NAM"),XB("VER"),.02)=XB("PKT")
S ^TMP($J,"P",XB("NSP"),XB("NAM"),XB("VER"),.03)=XB("PRK")
Q
;
SCHDR ;
W !,?IOM-$L(XB("HD1"))\2,XB("HD1"),!,?IOM-$L(XB("HD2"))\2,XB("HD2"),!
Q
;
PRT ;
S XB("PAGE")=0,XB("NSP")=""
D:'$D(ZTQUEUED)
. S IOP=XB("IOP")
. D ^%ZIS
.Q
U IO
D HDR
F S XB("NSP")=$O(^TMP($J,"P",XB("NSP"))) Q:XB("NSP")=""!(XB("END")) D
. S XB("NAM")=""
. F S XB("NAM")=$O(^TMP($J,"P",XB("NSP"),XB("NAM"))) Q:XB("NAM")=""!(XB("END")) D
.. D:XB("NAM")="%"
... W !!,"****",?5,"ROUTINES THAT ARE NOT IN PACKAGE FILE NAME-SPACE"
... W !?5,^TMP($J,"P",XB("NSP"),"%",0,.01)," TOTAL ROUTINE(s): "
... W ^TMP($J,"P",XB("NSP"),"%",0,.02)," PATCHE(s) in "
... W ^TMP($J,"P",XB("NSP"),"%",0,.03)," ROUTINE(s)",!
... S XB("NAM")=$O(^TMP($J,"P",XB("NSP"),XB("NAM")))
.. S XB("END")=(XB("NAM")="")
.. Q:XB("END")
.. S XB("VER")=.5
.. F S XB("VER")=$O(^TMP($J,"P",XB("NSP"),XB("NAM"),XB("VER"))) Q:XB("VER")=""!(XB("END")) D
... D:$Y+5>IOSL HDR
... Q:XB("END")
... W !!,XB("NSP"),?5,XB("NAM")," -- Version: ",XB("VER")
... D:XB("NSP")'="~~"
.... W !?5,^TMP($J,"P",XB("NSP"),XB("NAM"),XB("VER"),.01)," TOTAL ROUTINE(s): "
.... W ^TMP($J,"P",XB("NSP"),XB("NAM"),XB("VER"),.02)," PATCHE(s) in "
.... W ^TMP($J,"P",XB("NSP"),XB("NAM"),XB("VER"),.03)," ROUTINE(s)",!
... S XB("PNBR")=.5
... F S XB("PNBR")=$O(^TMP($J,"P",XB("NSP"),XB("NAM"),XB("VER"),XB("PNBR"))) Q:XB("PNBR")=""!(XB("END")) D
.... S XB("ROU")=""
.... F S XB("ROU")=$O(^TMP($J,"P",XB("NSP"),XB("NAM"),XB("VER"),XB("PNBR"),XB("ROU"))) Q:XB("ROU")=""!(XB("END")) D
..... D:$Y+5>IOSL HDR
..... Q:XB("END")
..... W !,$J(XB("PNBR"),4),?5,XB("ROU"),?14,^TMP($J,"P",XB("NSP"),XB("NAM"),XB("VER"),XB("PNBR"),XB("ROU"))
Q
;
HDR ;
NEW DIRUT,DUOUT
D:XB("PAGE")&($E(IOST,1,2)="C-")&(IO=IO(0))
. S Y=$$DIR^XBDIR("E")
. S:$D(DIRUT)!($D(DUOUT)) XB("END")=1
.Q
Q:XB("END")
HDR1 ;
D:$D(IO("S"))&('XB("PAGE"))
. S (DX,DY)=0
. X ^%ZOSF("XY")
.Q
W:$E(IOST,1,2)="C-"!(($E(IOST,1,2)'="C-")&(XB("PAGE"))) @IOF
HDR2 ;
S XB("PAGE")=XB("PAGE")+1
W !,?IOM-$L(XB("HD1"))\2,XB("HD1"),?(IOM-15),"PAGE: ",$J(XB("PAGE"),3)
W !,?IOM-$L(XB("HD2"))\2,XB("HD2")
W !,"PATCH"
W !,"NMBR",?5,"ROUTINE",?14,"ROUTINE DESCRIPTION"
W !,"==== ======== ",$$REPEAT^XLFSTR("=",IOM-19)
Q
;
EXIT ;
D ^%ZISC
KILL ^UTILITY($J),^TMP($J)
Q
;
XBPATSE ; IHS/ADC/GTH - SEARCH ROUTINES FOR PATCHES ; [ 10/29/2002 7:42 AM ]
+1 ;;3.0;IHS/VA UTILITIES;**9**;FEB 07, 1997
+2 ; XB*3*9 IHS/SET/GTH XB*3*9 10/29/2002 Cache' mods.
+3 ;
+4 ; Search Routines for Patch Versions.
+5 ;
+6 ; Thanks to Ray A. Willie for the original routine.
+7 ;
MAIN ;
+1 NEW XB,DUZ,IO,IOF,IOM,IOSL,IOBS,IOXY,IOST,DT,DTIME,POP,U,X,Y
+2 DO INIT
+3 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+4 DO RSEL
+5 IF 'XB("END")
DO DEVICE
+6 QUIT
End DoDot:1
+7 IF 'XB("END")
DO SRCH
+8 IF 'XB("END")
DO PRT
+9 DO EXIT
+10 QUIT
+11 ;
INIT ;
+1 SET (XB("END"),XB("VER"),XB("PNBR"),XB("Q"))=0
SET XB("NAM")=""
+2 KILL ^TMP($JOB)
+3 IF '$DATA(ZTQUEUED)
DO ^XBKVAR
DO DT^DICRW
DO HOME^%ZIS
+4 DO NOW^%DTC
+5 SET Y=%
+6 XECUTE ^DD("DD")
+7 SET XB("DT")=Y
+8 XECUTE ^%ZOSF("UCI")
+9 SET XB("UCI")=$PIECE(Y,",")
SET XB("VOL")=$PIECE(Y,",",2)
+10 SET XB("HD1")="R.P.M.S. PATCH SEARCH UTILITY Version: "_$PIECE($TEXT(+2),";",3)
+11 SET XB("HD2")="UCI: "_XB("UCI")_" CPU: "_XB("VOL")_" "_XB("DT")
+12 QUIT
+13 ;
RSEL ;
+1 DO SCHDR
+2 XECUTE ^%ZOSF("RSEL")
+3 SET XB("END")='$DATA(^UTILITY($JOB))
+4 QUIT
+5 ;
DEVICE ;
+1 NEW %ZIS
+2 SET %ZIS="NMQ"
+3 DO ^%ZIS
+4 SET XB("END")=POP
+5 IF XB("END")
QUIT
+6 SET XB("IOP")=ION_";"_IOST_$SELECT($DATA(IO("DOC")):";"_IO("DOC"),1:";"_IOM_";"_IOSL)
+7 IF $DATA(IO("Q"))
DO QUE
+8 QUIT
+9 ;
QUE ;
+1 NEW ZTRTN,ZTIO,ZTDESC,ZTSAVE,ZTSK
+2 IF IO=IO(0)&($EXTRACT(IOST,1,2)="C-")&($DATA(IO("Q"))#2)
Begin DoDot:1
+3 WRITE !,"Cannot Queue to HOME or CHARACTER Device",!
+4 SET XB("END")=1
+5 QUIT
End DoDot:1
+6 IF XB("END")
QUIT
+7 SET ZTRTN="^"_$TRANSLATE($PIECE($TEXT(+1),";")," ","")
SET ZTIO=XB("IOP")
SET ZTDESC=$PIECE($TEXT(+1),";",2)
+8 FOR
IF $EXTRACT(ZTDESC)'=" "
QUIT
SET ZTDESC=$EXTRACT(ZTDESC,2,99)
+9 SET ZTSAVE("^UTILITY($J,")=""
+10 DO ^%ZTLOAD
+11 IF '$DATA(ZTSK)
WRITE !,"TASK not Queued with Task Manager",!
SET XB("END")=1
+12 IF XB("END")
QUIT
+13 SET %H=ZTSK("D")
+14 DO YX^%DTC
+15 WRITE !,"TASK Queued with Task Manager: JOB # ",ZTSK," at ",Y,!
+16 DO HOME^%ZIS
+17 SET XB("END")=1
+18 QUIT
+19 ;
SRCH ;
+1 NEW XCNP,DIF
+2 IF '$DATA(ZTQUEUED)
DO SCHDR
+3 SET XB("NSP")=""
+4 FOR
SET XB("NSP")=$ORDER(^DIC(9.4,"C",XB("NSP")))
IF XB("NSP")=""
QUIT
Begin DoDot:1
+5 SET XB("EIN")=0
SET XB("EIN")=$ORDER(^DIC(9.4,"C",XB("NSP"),XB("EIN")))
+6 SET XB("NAM")=$PIECE($GET(^DIC(9.4,XB("EIN"),0)),U)
+7 SET XB("VER")=$GET(^DIC(9.4,XB("EIN"),"VERSION"),0)
+8 SET XB("ROU")=XB("NSP")
+9 IF $DATA(^UTILITY($JOB,XB("ROU")))
SET XB("ROU")=$ORDER(^UTILITY($JOB,XB("ROU")),-1)
+10 FOR XB("RKT")=0:1
SET XB("ROU")=$ORDER(^UTILITY($JOB,XB("ROU")))
IF $EXTRACT(XB("ROU"),1,$LENGTH(XB("NSP")))'=XB("NSP")
QUIT
DO SRCH1
+11 IF XB("RKT")>0
DO SRCH2
+12 QUIT
End DoDot:1
+13 ;S XB("NSP")="~~",XB("ROU")="";IHS/SET/GTH XB*3*9 10/29/2002
+14 ;IHS/SET/GTH XB*3*9 10/29/2002
SET XB("NSP")="~~"
SET XB("ROU")=0
+15 FOR XB("RKT")=0:1
SET XB("ROU")=$ORDER(^UTILITY($JOB,XB("ROU")))
IF XB("ROU")=""
QUIT
Begin DoDot:1
+16 SET XB("NAM")=""
SET XB("VER")=0
+17 DO SRCH1
+18 QUIT
End DoDot:1
+19 SET XB("NAM")="%"
SET XB("VER")=0
+20 IF XB("RKT")>0
DO SRCH2
+21 QUIT
+22 ;
SRCH1 ;
+1 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+2 IF '(XB("RKT")#8)
WRITE !
+3 WRITE XB("ROU"),$JUSTIFY("",9-$LENGTH(XB("ROU")))
+4 QUIT
End DoDot:1
+5 SET XCNP=0
SET DIF="^TMP("_$JOB_",""R"","""_XB("ROU")_""","
SET X=XB("ROU")
+6 XECUTE ^%ZOSF("TEST")
+7 IF '$TEST
QUIT
+8 XECUTE ^%ZOSF("LOAD")
+9 SET XB("PPC")=$TRANSLATE($PIECE($GET(^TMP($JOB,"R",XB("ROU"),2,0)),";",5),"*","")
+10 IF XB("PPC")]""&(XB("PPC")'=0)
Begin DoDot:1
+11 IF XB("NAM")=""
SET XB("NAM")=$PIECE($GET(^TMP($JOB,"R",XB("ROU"),2,0)),";",4)
+12 IF XB("VER")=0
SET XB("VER")=$PIECE($GET(^TMP($JOB,"R",XB("ROU"),2,0)),";",3)
+13 SET XB("DESC")=$SELECT($PIECE($PIECE($GET(^TMP($JOB,"R",XB("ROU"),1,0)),";",2),"-",2,3)'="":$PIECE($PIECE($GET(^TMP($JOB,"R",XB("ROU"),1,0)),";",2),"-",2,3),1:$PIECE($GET(^TMP($JOB,"R",XB("ROU"),1,0)),";",3))
+14 FOR
IF $EXTRACT(XB("DESC"))'=" "
QUIT
SET XB("DESC")=$EXTRACT(XB("DESC"),2,99)
+15 IF XB("VER")]""&(XB("NAM")]"")
Begin DoDot:2
+16 FOR XB("J")=1:1
SET XB("PNR")=$PIECE(XB("PPC"),",",XB("J"))
IF XB("PNR")=""
QUIT
IF XB("PNR")?1.4N
Begin DoDot:3
+17 SET ^TMP($JOB,"P",XB("NSP"),XB("NAM"),XB("VER"),XB("PNR"),XB("ROU"))=XB("DESC")
+18 SET ^TMP($JOB,"P","P",XB("PNR"))=""
+19 SET ^TMP($JOB,"P","R",XB("ROU"))=""
End DoDot:3
End DoDot:2
End DoDot:1
+20 KILL ^TMP($JOB,"R",XB("ROU")),^UTILITY($JOB,XB("ROU"))
+21 QUIT
+22 ;
SRCH2 ;
+1 IF '$DATA(ZTQUEUED)
WRITE !!?5,XB("RKT")," Routines Processed",!!
+2 SET (XB("PNR"),XB("ROU"))=""
+3 FOR XB("PKT")=0:1
SET XB("PNR")=$ORDER(^TMP($JOB,"P","P",XB("PNR")))
IF XB("PNR")=""
QUIT
+4 FOR XB("PRK")=0:1
SET XB("ROU")=$ORDER(^TMP($JOB,"P","R",XB("ROU")))
IF XB("ROU")=""
QUIT
+5 KILL ^TMP($JOB,"P","P"),^TMP($JOB,"P","R")
+6 SET ^TMP($JOB,"P",XB("NSP"),XB("NAM"),XB("VER"),.01)=XB("RKT")
+7 SET ^TMP($JOB,"P",XB("NSP"),XB("NAM"),XB("VER"),.02)=XB("PKT")
+8 SET ^TMP($JOB,"P",XB("NSP"),XB("NAM"),XB("VER"),.03)=XB("PRK")
+9 QUIT
+10 ;
SCHDR ;
+1 WRITE !,?IOM-$LENGTH(XB("HD1"))\2,XB("HD1"),!,?IOM-$LENGTH(XB("HD2"))\2,XB("HD2"),!
+2 QUIT
+3 ;
PRT ;
+1 SET XB("PAGE")=0
SET XB("NSP")=""
+2 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+3 SET IOP=XB("IOP")
+4 DO ^%ZIS
+5 QUIT
End DoDot:1
+6 USE IO
+7 DO HDR
+8 FOR
SET XB("NSP")=$ORDER(^TMP($JOB,"P",XB("NSP")))
IF XB("NSP")=""!(XB("END"))
QUIT
Begin DoDot:1
+9 SET XB("NAM")=""
+10 FOR
SET XB("NAM")=$ORDER(^TMP($JOB,"P",XB("NSP"),XB("NAM")))
IF XB("NAM")=""!(XB("END"))
QUIT
Begin DoDot:2
+11 IF XB("NAM")="%"
Begin DoDot:3
+12 WRITE !!,"****",?5,"ROUTINES THAT ARE NOT IN PACKAGE FILE NAME-SPACE"
+13 WRITE !?5,^TMP($JOB,"P",XB("NSP"),"%",0,.01)," TOTAL ROUTINE(s): "
+14 WRITE ^TMP($JOB,"P",XB("NSP"),"%",0,.02)," PATCHE(s) in "
+15 WRITE ^TMP($JOB,"P",XB("NSP"),"%",0,.03)," ROUTINE(s)",!
+16 SET XB("NAM")=$ORDER(^TMP($JOB,"P",XB("NSP"),XB("NAM")))
End DoDot:3
+17 SET XB("END")=(XB("NAM")="")
+18 IF XB("END")
QUIT
+19 SET XB("VER")=.5
+20 FOR
SET XB("VER")=$ORDER(^TMP($JOB,"P",XB("NSP"),XB("NAM"),XB("VER")))
IF XB("VER")=""!(XB("END"))
QUIT
Begin DoDot:3
+21 IF $Y+5>IOSL
DO HDR
+22 IF XB("END")
QUIT
+23 WRITE !!,XB("NSP"),?5,XB("NAM")," -- Version: ",XB("VER")
+24 IF XB("NSP")'="~~"
Begin DoDot:4
+25 WRITE !?5,^TMP($JOB,"P",XB("NSP"),XB("NAM"),XB("VER"),.01)," TOTAL ROUTINE(s): "
+26 WRITE ^TMP($JOB,"P",XB("NSP"),XB("NAM"),XB("VER"),.02)," PATCHE(s) in "
+27 WRITE ^TMP($JOB,"P",XB("NSP"),XB("NAM"),XB("VER"),.03)," ROUTINE(s)",!
End DoDot:4
+28 SET XB("PNBR")=.5
+29 FOR
SET XB("PNBR")=$ORDER(^TMP($JOB,"P",XB("NSP"),XB("NAM"),XB("VER"),XB("PNBR")))
IF XB("PNBR")=""!(XB("END"))
QUIT
Begin DoDot:4
+30 SET XB("ROU")=""
+31 FOR
SET XB("ROU")=$ORDER(^TMP($JOB,"P",XB("NSP"),XB("NAM"),XB("VER"),XB("PNBR"),XB("ROU")))
IF XB("ROU")=""!(XB("END"))
QUIT
Begin DoDot:5
+32 IF $Y+5>IOSL
DO HDR
+33 IF XB("END")
QUIT
+34 WRITE !,$JUSTIFY(XB("PNBR"),4),?5,XB("ROU"),?14,^TMP($JOB,"P",XB("NSP"),XB("NAM"),XB("VER"),XB("PNBR"),XB("ROU"))
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+35 QUIT
+36 ;
HDR ;
+1 NEW DIRUT,DUOUT
+2 IF XB("PAGE")&($EXTRACT(IOST,1,2)="C-")&(IO=IO(0))
Begin DoDot:1
+3 SET Y=$$DIR^XBDIR("E")
+4 IF $DATA(DIRUT)!($DATA(DUOUT))
SET XB("END")=1
+5 QUIT
End DoDot:1
+6 IF XB("END")
QUIT
HDR1 ;
+1 IF $DATA(IO("S"))&('XB("PAGE"))
Begin DoDot:1
+2 SET (DX,DY)=0
+3 XECUTE ^%ZOSF("XY")
+4 QUIT
End DoDot:1
+5 IF $EXTRACT(IOST,1,2)="C-"!(($EXTRACT(IOST,1,2)'="C-")&(XB("PAGE")))
WRITE @IOF
HDR2 ;
+1 SET XB("PAGE")=XB("PAGE")+1
+2 WRITE !,?IOM-$LENGTH(XB("HD1"))\2,XB("HD1"),?(IOM-15),"PAGE: ",$JUSTIFY(XB("PAGE"),3)
+3 WRITE !,?IOM-$LENGTH(XB("HD2"))\2,XB("HD2")
+4 WRITE !,"PATCH"
+5 WRITE !,"NMBR",?5,"ROUTINE",?14,"ROUTINE DESCRIPTION"
+6 WRITE !,"==== ======== ",$$REPEAT^XLFSTR("=",IOM-19)
+7 QUIT
+8 ;
EXIT ;
+1 DO ^%ZISC
+2 KILL ^UTILITY($JOB),^TMP($JOB)
+3 QUIT
+4 ;
