VistA-IHS-VA_UTILITIES-XB/XBRPTL.m

53 lines
1.2 KiB
Mathematica
Raw Permalink Normal View History

XBRPTL ; IHS/ADC/GTH - PRINT ROUTINE TO FIRST LABEL ; [ 10/29/2002 7:42 AM ]
;;4.0;XB;;Jul 20, 2009;Build 2
; XB*3*9 IHS/SET/GTH XB*3*9 10/29/2002 Cache' mods.
;
; This routine prints selected routines down to the first
; label.
;
START ;
KILL ^UTILITY($J)
X ^%ZOSF("RSEL")
D ^%ZIS
PRINT ;
KILL ^TMP("XBRPTL",$J)
NEW %,I,L,R,X,Y
U IO
W @IOF
;S XBRPTLQ=0,R="";IHS/SET/GTH XB*3*9 10/29/2002
S XBRPTLQ=0,R=0 ;IHS/SET/GTH XB*3*9 10/29/2002
F L=0:0 KILL XBRPTL Q:XBRPTLQ S R=$O(^UTILITY($J,R)) Q:R="" D
. S DIF="^TMP(""XBRPTL"",$J,",XCNP=0,X=R
. X ^%ZOSF("LOAD")
. S XBRPTL(1)=^TMP("XBRPTL",$J,1,0)
. F I=2:1 S Y=$G(^TMP("XBRPTL",$J,I,0)) Q:(Y="")!($E(Y,1,2)'=" ;") S XBRPTL(I)=Y
. S I=I-1
. D TOP
. W !!!
. I $D(XBRPTL) F %=1:1:I W XBRPTL(%),! I IO=IO(0)&($E(IOST,1,2)="C-")&($Y>(IOSL-4)) D PAGE S:$D(DUOUT) %=I,XBRPTLQ=1
.Q
;
KILL DTOUT,DUOUT,XBRPTLQ
KILL ^UTILITY($J)
I IO'=IO(0)!($E(IOST,1,2)="P-") W @IOF D:'$D(XBRPTLE) ^%ZISC
KILL DIF,XBRPTLE,XCNP
KILL ^TMP("XBRPTL",$J)
Q
;
TOP ;
I IO'=IO(0)!($E(IOST,1,2)="P-") W:$Y+I+3>IOSL @IOF
Q
;
PAGE ;
NEW %,I,X
S Y=$$DIR^XBDIR("E")
W:'$D(DUOUT) @IOF
Q
;
EN ;PEP - Print routines down to first label.
S XBRPTLE=1
D PRINT
KILL XBRPTLE
Q
;