XBLZRO.m

XBLZRO ; IHS/ADC/GTH - LISTS 0TH NODES ; [ 02/07/97   3:02 PM ]

 ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997

 ;

 ; This routine lists the 0th nodes of FileMan files.

 ;

START ;

 NEW QFLG

 S QFLG=0

 W !,"^XBLZRO - This routine lists the 0th nodes of FileMan files."

 D ^XBDSET

 Q:'$D(^UTILITY("XBDSET",$J))

 D DEVICE

 I QFLG KILL QFLG Q

EN ;PEP - List 0th node of pre-selected list of FileMan files.

 ; IOF,IOSL must be set and U IO if appropriate.

 I $D(IOF)#2,$D(IOSL)#2

 E  Q

 NEW F,G,N,X,QFLG

 S QFLG=0

 D HEADER

 S F=0

 F  S F=$O(^UTILITY("XBDSET",$J,F)) Q:F'=+F  I $D(^DIC(F,0,"GL")) S G=^("GL") D LIST Q:QFLG

 D ^%ZISC

 Q

 ;

LIST ;

 S X=$L(G),X=$E(G,1,X-1)_$S($E(G,X)=",":",0)",1:"(0)")

 S N="<DOES NOT EXIST>"

 S:$D(@X) N=^(0)

 D:$Y>(IOSL-3) PAGE

 Q:QFLG

 W F,?15,X,?35,N,!

 Q

 ;

PAGE ; PAGE BREAK

 NEW F,G,N,X

 I IO=IO(0),$E(IOST,1,2)="C-" S Y=$$DIR^XBDIR("E") S:$D(DIRUT)!($D(DUOUT)) QFLG=1 KILL DIRUT,DUOUT

 Q:QFLG

 D HEADER

 Q

 ;

HEADER ; PRINT HEADER

 NEW TITLE,TM,HR,MIN,TME,UCI

 W:$D(IOF) @IOF

 S TITLE="FILE 0TH NODE LIST",TM=$P($H,",",2),HR=TM\3600,MIN=TM#3600\60

 S:MIN<10 MIN="0"_MIN

 S TME=HR_":"_MIN

 I '$D(DT) S %DT="",X="T" D ^%DT S DT=Y

 S Y=DT

 X ^DD("DD")

 W Y,"@",TME,?30,TITLE

 X ^%ZOSF("UCI")

 S UCI="UCI: "_$P(Y,",",1)

 W ?65,UCI,!,"FILE",?15,"GLOBAL",?35,"0TH NODE",!!

 Q

 ;

DEVICE ; GET DEVICE (QUEUEING ALLOWED)

 W !

 S %ZIS="Q"

 D ^%ZIS

 I POP S QFLG=1 KILL POP Q

 I $D(IO("Q")) D  S QFLG=1 Q

 . S ZTRTN="EN^XBLZRO",ZTIO=ION,ZTDESC="List 0th nodes",ZTSAVE("^UTILITY(""XBDSET"",$J,")=""

 . D ^%ZTLOAD

 . W !!,$S($D(ZTSK):"Request queued!",1:"Request cancelled!")

 . D ^%ZISC

 . KILL ZTSK,IO("Q")

 . KILL ZTIO ; ^%ZTLOAD kills other ZT* variables, but not this one

 . Q

 U IO

 Q

 ;

XBLZRO    ; IHS/ADC/GTH - LISTS 0TH NODES ; [ 02/07/97   3:02 PM ]

 +1       ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997

 +2       ;

 +3       ; This routine lists the 0th nodes of FileMan files.

 +4       ;

START     ;

 +1        NEW QFLG

 +2        SET QFLG=0

 +3        WRITE !,"^XBLZRO - This routine lists the 0th nodes of FileMan files."

 +4        DO ^XBDSET

 +5        IF '$DATA(^UTILITY("XBDSET",$JOB))

               QUIT 

 +6        DO DEVICE

 +7        IF QFLG

               KILL QFLG

               QUIT 

EN        ;PEP - List 0th node of pre-selected list of FileMan files.

 +1       ; IOF,IOSL must be set and U IO if appropriate.

 +2        IF $DATA(IOF)#2

               IF $DATA(IOSL)#2

 +3       IF '$TEST

               QUIT 

 +4        NEW F,G,N,X,QFLG

 +5        SET QFLG=0

 +6        DO HEADER

 +7        SET F=0

 +8        FOR 

               SET F=$ORDER(^UTILITY("XBDSET",$JOB,F))

               IF F'=+F

                   QUIT 

               IF $DATA(^DIC(F,0,"GL"))

                   SET G=^("GL")

                   DO LIST

                   IF QFLG

                       QUIT 

 +9        DO ^%ZISC

 +10       QUIT 

 +11      ;

LIST      ;

 +1        SET X=$LENGTH(G)

           SET X=$EXTRACT(G,1,X-1)_$SELECT($EXTRACT(G,X)=",":",0)",1:"(0)")

 +2        SET N="<DOES NOT EXIST>"

 +3        IF $DATA(@X)

               SET N=^(0)

 +4        IF $Y>(IOSL-3)

               DO PAGE

 +5        IF QFLG

               QUIT 

 +6        WRITE F,?15,X,?35,N,!

 +7        QUIT 

 +8       ;

PAGE      ; PAGE BREAK

 +1        NEW F,G,N,X

 +2        IF IO=IO(0)

               IF $EXTRACT(IOST,1,2)="C-"

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

                   IF $DATA(DIRUT)!($DATA(DUOUT))

                       SET QFLG=1

                   KILL DIRUT,DUOUT

 +3        IF QFLG

               QUIT 

 +4        DO HEADER

 +5        QUIT 

 +6       ;

HEADER    ; PRINT HEADER

 +1        NEW TITLE,TM,HR,MIN,TME,UCI

 +2        IF $DATA(IOF)

               WRITE @IOF

 +3        SET TITLE="FILE 0TH NODE LIST"

           SET TM=$PIECE($HOROLOG,",",2)

           SET HR=TM\3600

           SET MIN=TM#3600\60

 +4        IF MIN<10

               SET MIN="0"_MIN

 +5        SET TME=HR_":"_MIN

 +6        IF '$DATA(DT)

               SET %DT=""

               SET X="T"

               DO ^%DT

               SET DT=Y

 +7        SET Y=DT

 +8        XECUTE ^DD("DD")

 +9        WRITE Y,"@",TME,?30,TITLE

 +10       XECUTE ^%ZOSF("UCI")

 +11       SET UCI="UCI: "_$PIECE(Y,",",1)

 +12       WRITE ?65,UCI,!,"FILE",?15,"GLOBAL",?35,"0TH NODE",!!

 +13       QUIT 

 +14      ;

DEVICE    ; GET DEVICE (QUEUEING ALLOWED)

 +1        WRITE !

 +2        SET %ZIS="Q"

 +3        DO ^%ZIS

 +4        IF POP

               SET QFLG=1

               KILL POP

               QUIT 

 +5        IF $DATA(IO("Q"))

               Begin DoDot:1

 +6                SET ZTRTN="EN^XBLZRO"

                   SET ZTIO=ION

                   SET ZTDESC="List 0th nodes"

                   SET ZTSAVE("^UTILITY(""XBDSET"",$J,")=""

 +7                DO ^%ZTLOAD

 +8                WRITE !!,$SELECT($DATA(ZTSK):"Request queued!",1:"Request cancelled!")

 +9                DO ^%ZISC

 +10               KILL ZTSK,IO("Q")

 +11      ; ^%ZTLOAD kills other ZT* variables, but not this one

                   KILL ZTIO

 +12               QUIT 

               End DoDot:1

               SET QFLG=1

               QUIT 

 +13       USE IO

 +14       QUIT 

 +15      ;