source: IHS-VA_UTILITIES-XB/trunk/XBRPTL.m@ 1545

Last change on this file since 1545 was 642, checked in by Sam Habiel, 15 years ago

Modified directory structure; moved routines.

File size: 1.2 KB
Line 
1XBRPTL ; IHS/ADC/GTH - PRINT ROUTINE TO FIRST LABEL ; [ 10/29/2002 7:42 AM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ; XB*3*9 IHS/SET/GTH XB*3*9 10/29/2002 Cache' mods.
4 ;
5 ; This routine prints selected routines down to the first
6 ; label.
7 ;
8START ;
9 KILL ^UTILITY($J)
10 X ^%ZOSF("RSEL")
11 D ^%ZIS
12PRINT ;
13 KILL ^TMP("XBRPTL",$J)
14 NEW %,I,L,R,X,Y
15 U IO
16 W @IOF
17 ;S XBRPTLQ=0,R="";IHS/SET/GTH XB*3*9 10/29/2002
18 S XBRPTLQ=0,R=0 ;IHS/SET/GTH XB*3*9 10/29/2002
19 F L=0:0 KILL XBRPTL Q:XBRPTLQ S R=$O(^UTILITY($J,R)) Q:R="" D
20 . S DIF="^TMP(""XBRPTL"",$J,",XCNP=0,X=R
21 . X ^%ZOSF("LOAD")
22 . S XBRPTL(1)=^TMP("XBRPTL",$J,1,0)
23 . F I=2:1 S Y=$G(^TMP("XBRPTL",$J,I,0)) Q:(Y="")!($E(Y,1,2)'=" ;") S XBRPTL(I)=Y
24 . S I=I-1
25 . D TOP
26 . W !!!
27 . 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
28 .Q
29 ;
30 KILL DTOUT,DUOUT,XBRPTLQ
31 KILL ^UTILITY($J)
32 I IO'=IO(0)!($E(IOST,1,2)="P-") W @IOF D:'$D(XBRPTLE) ^%ZISC
33 KILL DIF,XBRPTLE,XCNP
34 KILL ^TMP("XBRPTL",$J)
35 Q
36 ;
37TOP ;
38 I IO'=IO(0)!($E(IOST,1,2)="P-") W:$Y+I+3>IOSL @IOF
39 Q
40 ;
41PAGE ;
42 NEW %,I,X
43 S Y=$$DIR^XBDIR("E")
44 W:'$D(DUOUT) @IOF
45 Q
46 ;
47EN ;PEP - Print routines down to first label.
48 S XBRPTLE=1
49 D PRINT
50 KILL XBRPTLE
51 Q
52 ;
Note: See TracBrowser for help on using the repository browser.