[641] | 1 | XBHEDD10 ;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
|
---|
| 4 | PT ;Pointers from this file
|
---|
| 5 | D INIT^XBHEDD7 S HD="HD1" D @HD,PTGET
|
---|
| 6 | PTEX ;
|
---|
| 7 | K CNT,NAME,NODE0,NUMBER,ZDD
|
---|
| 8 | Q
|
---|
| 9 | PTGET ;
|
---|
| 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
|
---|
| 14 | PTLIST ;
|
---|
| 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
|
---|
| 20 | GL ;List Globals in ASCII order
|
---|
| 21 | D:'$D(^UTILITY("EDD/GL")) HELP
|
---|
| 22 | GLTOP 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
|
---|
| 24 | GLEX ;Global Exit
|
---|
| 25 | K AA,BB,CNT,HD,TEMP,VAR,XXX
|
---|
| 26 | Q
|
---|
| 27 | GLRANGE ;Starting and Ending Global
|
---|
| 28 | I FLAGP W !?8,"Enter Global range...Include Starting & Ending Global:"
|
---|
| 29 | GLRANGE1 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
|
---|
| 36 | GLLIST ;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
|
---|
| 39 | GLLOAD ;
|
---|
| 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
|
---|
| 43 | HELP ;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
|
---|
| 48 | HELP1 ;"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
|
---|
| 57 | PAGE ;
|
---|
| 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
|
---|
| 62 | HD ;
|
---|
| 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
|
---|
| 67 | HD1 ;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
|
---|
| 70 | INIT ;
|
---|
| 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
|
---|