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
;
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 ;
+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 ;
