XBRPTL.m

XBRPTL ; IHS/ADC/GTH - PRINT ROUTINE TO FIRST LABEL ; [ 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.

 ;

 ; 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

 ;

XBRPTL    ; IHS/ADC/GTH - PRINT ROUTINE TO FIRST LABEL ; [ 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       ; This routine prints selected routines down to the first

 +5       ; label.

 +6       ;

START     ;

 +1        KILL ^UTILITY($JOB)

 +2        XECUTE ^%ZOSF("RSEL")

 +3        DO ^%ZIS

PRINT     ;

 +1        KILL ^TMP("XBRPTL",$JOB)

 +2        NEW %,I,L,R,X,Y

 +3        USE IO

 +4        WRITE @IOF

 +5       ;S XBRPTLQ=0,R="";IHS/SET/GTH XB*3*9 10/29/2002

 +6       ;IHS/SET/GTH XB*3*9 10/29/2002

           SET XBRPTLQ=0

           SET R=0

 +7        FOR L=0:0

               KILL XBRPTL

               IF XBRPTLQ

                   QUIT 

               SET R=$ORDER(^UTILITY($JOB,R))

               IF R=""

                   QUIT 

               Begin DoDot:1

 +8                SET DIF="^TMP(""XBRPTL"",$J,"

                   SET XCNP=0

                   SET X=R

 +9                XECUTE ^%ZOSF("LOAD")

 +10               SET XBRPTL(1)=^TMP("XBRPTL",$JOB,1,0)

 +11               FOR I=2:1

                       SET Y=$GET(^TMP("XBRPTL",$JOB,I,0))

                       IF (Y="")!($EXTRACT(Y,1,2)'=" ;")

                           QUIT 

                       SET XBRPTL(I)=Y

 +12               SET I=I-1

 +13               DO TOP

 +14               WRITE !!!

 +15               IF $DATA(XBRPTL)

                       FOR %=1:1:I

                           WRITE XBRPTL(%),!

                           IF IO=IO(0)&($EXTRACT(IOST,1,2)="C-")&($Y>(IOSL-4))

                               DO PAGE

                               IF $DATA(DUOUT)

                                   SET %=I

                                   SET XBRPTLQ=1

 +16               QUIT 

               End DoDot:1

 +17      ;

 +18       KILL DTOUT,DUOUT,XBRPTLQ

 +19       KILL ^UTILITY($JOB)

 +20       IF IO'=IO(0)!($EXTRACT(IOST,1,2)="P-")

               WRITE @IOF

               IF '$DATA(XBRPTLE)

                   DO ^%ZISC

 +21       KILL DIF,XBRPTLE,XCNP

 +22       KILL ^TMP("XBRPTL",$JOB)

 +23       QUIT 

 +24      ;

TOP       ;

 +1        IF IO'=IO(0)!($EXTRACT(IOST,1,2)="P-")

               IF $Y+I+3>IOSL

                   WRITE @IOF

 +2        QUIT 

 +3       ;

PAGE      ;

 +1        NEW %,I,X

 +2        SET Y=$$DIR^XBDIR("E")

 +3        IF '$DATA(DUOUT)

               WRITE @IOF

 +4        QUIT 

 +5       ;

EN        ;PEP - Print routines down to first label.

 +1        SET XBRPTLE=1

 +2        DO PRINT

 +3        KILL XBRPTLE

 +4        QUIT 

 +5       ;