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