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

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
        ;