source: IHS-VA_UTILITIES-XB/trunk/XBLZRO.m@ 1589

Last change on this file since 1589 was 642, checked in by Sam Habiel, 15 years ago

Modified directory structure; moved routines.

File size: 1.7 KB
Line 
1XBLZRO ; 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 ;
6START ;
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
14EN ;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 ;
26LIST ;
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 ;
35PAGE ; 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 ;
42HEADER ; 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 ;
57DEVICE ; 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 ;
Note: See TracBrowser for help on using the repository browser.