1 | XBLZRO ; IHS/ADC/GTH - LISTS 0TH NODES ; [ 02/07/97 3:02 PM ]
|
---|
2 | ;;4.0;XB;;Jul 20, 2009;Build 2
|
---|
3 | ;
|
---|
4 | ; This routine lists the 0th nodes of FileMan files.
|
---|
5 | ;
|
---|
6 | START ;
|
---|
7 | NEW QFLG
|
---|
8 | S QFLG=0
|
---|
9 | W !,"^XBLZRO - This routine lists the 0th nodes of FileMan files."
|
---|
10 | D ^XBDSET
|
---|
11 | Q:'$D(^UTILITY("XBDSET",$J))
|
---|
12 | D DEVICE
|
---|
13 | I QFLG KILL QFLG Q
|
---|
14 | EN ;PEP - List 0th node of pre-selected list of FileMan files.
|
---|
15 | ; IOF,IOSL must be set and U IO if appropriate.
|
---|
16 | I $D(IOF)#2,$D(IOSL)#2
|
---|
17 | E Q
|
---|
18 | NEW F,G,N,X,QFLG
|
---|
19 | S QFLG=0
|
---|
20 | D HEADER
|
---|
21 | S F=0
|
---|
22 | F S F=$O(^UTILITY("XBDSET",$J,F)) Q:F'=+F I $D(^DIC(F,0,"GL")) S G=^("GL") D LIST Q:QFLG
|
---|
23 | D ^%ZISC
|
---|
24 | Q
|
---|
25 | ;
|
---|
26 | LIST ;
|
---|
27 | S X=$L(G),X=$E(G,1,X-1)_$S($E(G,X)=",":",0)",1:"(0)")
|
---|
28 | S N="<DOES NOT EXIST>"
|
---|
29 | S:$D(@X) N=^(0)
|
---|
30 | D:$Y>(IOSL-3) PAGE
|
---|
31 | Q:QFLG
|
---|
32 | W F,?15,X,?35,N,!
|
---|
33 | Q
|
---|
34 | ;
|
---|
35 | PAGE ; PAGE BREAK
|
---|
36 | NEW F,G,N,X
|
---|
37 | I IO=IO(0),$E(IOST,1,2)="C-" S Y=$$DIR^XBDIR("E") S:$D(DIRUT)!($D(DUOUT)) QFLG=1 KILL DIRUT,DUOUT
|
---|
38 | Q:QFLG
|
---|
39 | D HEADER
|
---|
40 | Q
|
---|
41 | ;
|
---|
42 | HEADER ; PRINT HEADER
|
---|
43 | NEW TITLE,TM,HR,MIN,TME,UCI
|
---|
44 | W:$D(IOF) @IOF
|
---|
45 | S TITLE="FILE 0TH NODE LIST",TM=$P($H,",",2),HR=TM\3600,MIN=TM#3600\60
|
---|
46 | S:MIN<10 MIN="0"_MIN
|
---|
47 | S TME=HR_":"_MIN
|
---|
48 | I '$D(DT) S %DT="",X="T" D ^%DT S DT=Y
|
---|
49 | S Y=DT
|
---|
50 | X ^DD("DD")
|
---|
51 | W Y,"@",TME,?30,TITLE
|
---|
52 | X ^%ZOSF("UCI")
|
---|
53 | S UCI="UCI: "_$P(Y,",",1)
|
---|
54 | W ?65,UCI,!,"FILE",?15,"GLOBAL",?35,"0TH NODE",!!
|
---|
55 | Q
|
---|
56 | ;
|
---|
57 | DEVICE ; GET DEVICE (QUEUEING ALLOWED)
|
---|
58 | W !
|
---|
59 | S %ZIS="Q"
|
---|
60 | D ^%ZIS
|
---|
61 | I POP S QFLG=1 KILL POP Q
|
---|
62 | I $D(IO("Q")) D S QFLG=1 Q
|
---|
63 | . S ZTRTN="EN^XBLZRO",ZTIO=ION,ZTDESC="List 0th nodes",ZTSAVE("^UTILITY(""XBDSET"",$J,")=""
|
---|
64 | . D ^%ZTLOAD
|
---|
65 | . W !!,$S($D(ZTSK):"Request queued!",1:"Request cancelled!")
|
---|
66 | . D ^%ZISC
|
---|
67 | . KILL ZTSK,IO("Q")
|
---|
68 | . KILL ZTIO ; ^%ZTLOAD kills other ZT* variables, but not this one
|
---|
69 | . Q
|
---|
70 | U IO
|
---|
71 | Q
|
---|
72 | ;
|
---|