source: IHS-VA_UTILITIES-XB/XBHEDD10.m@ 641

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

Initial commit of XB, move away from sf.net.
Includes kids file and documentation.

File size: 3.5 KB
Line 
1XBHEDD10 ;402,DJB,10/23/91,EDD - Pointers From This File and Global Listing
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;;David Bolduc - Togus, ME
4PT ;Pointers from this file
5 D INIT^XBHEDD7 S HD="HD1" D @HD,PTGET
6PTEX ;
7 K CNT,NAME,NODE0,NUMBER,ZDD
8 Q
9PTGET ;
10 S ZDD="",CNT=1
11 F S ZDD=$O(^UTILITY($J,"TMP",ZDD)) Q:ZDD=""!(FLAGQ) S NAME="" F S NAME=$O(^DD(ZDD,"B",NAME)) Q:NAME="" S NUMBER="",NUMBER=$O(^DD(ZDD,"B",NAME,"")) D PTLIST Q:FLAGQ
12 I CNT=1 W !!!!!?20,"This file has no fields that",!?20,"point to other files."
13 Q
14PTLIST ;
15 Q:^DD(ZDD,"B",NAME,NUMBER)=1 ;If this node equals 1 it is TITLE not NAME
16 S NODE0=^DD(ZDD,NUMBER,0) Q:$P(NODE0,U,2)'["P" Q:$P(NODE0,U,3)']""
17 W !?1,$S(ZDD'=ZNUM:"MULT",1:""),?6,$J(NUMBER,8),?16,NAME S FILE="^"_$P(NODE0,U,3)_"0)" W ?48,$S($D(@FILE):$E($P(@FILE,U),1,30),1:"-->No such file")
18 S CNT=CNT+1 I $Y>SIZE D PAGE Q:FLAGQ=1
19 Q
20GL ;List Globals in ASCII order
21 D:'$D(^UTILITY("EDD/GL")) HELP
22GLTOP D @$S($D(^UTILITY("EDD/GL")):"GLRANGE",1:"GLRANGE1") G:FLAGQ GLEX D INIT S HD="HD" D @HD
23 D GLLIST G:FLAGQ GLEX
24GLEX ;Global Exit
25 K AA,BB,CNT,HD,TEMP,VAR,XXX
26 Q
27GLRANGE ;Starting and Ending Global
28 I FLAGP W !?8,"Enter Global range...Include Starting & Ending Global:"
29GLRANGE1 R !?8,"Starting Global: ^",AA:DTIME S:'$T!(AA="") AA="^" S:AA["^" FLAGQ=1 S:AA="^^" FLAGE=1 Q:FLAGQ
30 I AA="?"!(AA="*R") D:AA="?" HELP1 D:AA="*R" GLLOAD G GLRANGE
31 I '$D(^UTILITY("EDD/GL")) W *7," Enter '*R' to build your Global listing." G GLRANGE1
32 S AA=$S(AA="*":0,1:"^"_AA)
33 S BB="^ZZZZZZZZZ" I FLAGP R !?8,"Ending Global: ^",BB:DTIME S:'$T!(BB="") BB="^" G:BB="^" GLRANGE S BB="^"_BB I BB']AA W *7," Ending Global must 'follow' Starting Global" G GLRANGE1
34 I FLAGP S TEMP=$O(^UTILITY("EDD/GL",AA)) I TEMP=""!(TEMP]BB) W *7," No globals in this range" G GLRANGE1
35 Q
36GLLIST ;Start listing Globals
37 F S AA=$O(^UTILITY("EDD/GL",AA)) Q:AA=""!(AA]BB) W !?2,AA,?23,$J($P(^(AA),U),14),?40,$E($P(^(AA),U,2),1,35) I $Y>SIZE D PAGE Q:FLAGQ
38 Q
39GLLOAD ;
40 S AA=0,CNT=1 K ^UTILITY("EDD/GL")
41 F S AA=$O(^DIC(AA)) Q:AA'>0 I $D(^DIC(AA,0,"GL")) S ^UTILITY("EDD/GL",^DIC(AA,0,"GL"))=AA_"^"_$P(^DIC(AA,0),"^") W "."
42 Q
43HELP ;No data in ^UTILITY("EDD/GL")
44 W *7,?35,"You have no data in ^UTILITY(""EDD/GL"")."
45 W !?35,"You must first build your Global listing."
46 W !?35,"Enter '?' at the 'Starting Global:' prompt."
47 Q
48HELP1 ;"Starting Global" prompt
49 W !!?8,"1. Enter Global you want listing to start with.",!?11,"Examples: ^DPT , ^L , or ^%ZIS."
50 W !?8,"2. Enter '*' to list all globals."
51 W !?8,"3. Enter '*R' to Build/Update your Global listing."
52 W !?14,"Your Global listing is kept in ^UTILITY(""EDD/GL""). If this is the"
53 W !?14,"first time you've used this utility, or if you have added or"
54 W !?14,"deleted any files on your system, enter '*R' here to build/update"
55 W !?14,"your listing. It will take approximately 30 seconds to run."
56 Q
57PAGE ;
58 I FLAGP,IO'=IO(0) W @IOF,!!! D @HD Q
59 R !!?2,"<RETURN> to continue, '^' to quit, '^^' to exit: ",Z1:DTIME S:'$T Z1="^" I Z1["^" S FLAGQ=1 S:Z1="^^" FLAGE=1 Q
60 W @IOF D @HD
61 Q
62HD ;
63 W !?2,"Globals in ASCII order:"
64 W !?10,"GLOBAL",?28,"FILE NUM",?46,"FILE (Truncated to 35)"
65 W !,?2,"----------------------",?27,"----------",?40,"-----------------------------------"
66 Q
67HD1 ;Pointers from this file
68 W !?3,"Pointers FROM this file..",!?6,"FLD NUM",?26,"FIELD NAME",?52,"FILE (Truncated to 30)",!?6,"--------",?16,"------------------------------",?48,"------------------------------"
69 Q
70INIT ;
71 I FLAGP,IO=IO(0),IOSL>25 D SCROLL^XBHEDD7 Q:FLAGQ
72 I FLAGP W:IO'=IO(0) " Printing.." U IO
73 W @IOF Q
Note: See TracBrowser for help on using the repository browser.