- 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 ;
