XBHEDD10 ;402,DJB,10/23/91,EDD - Pointers From This File and Global Listing
;;2.6;IHS UTILITIES;;JUN 28, 1993
;;David Bolduc - Togus, ME
PT ;Pointers from this file
D INIT^XBHEDD7 S HD="HD1" D @HD,PTGET
PTEX ;
K CNT,NAME,NODE0,NUMBER,ZDD
Q
PTGET ;
S ZDD="",CNT=1
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
I CNT=1 W !!!!!?20,"This file has no fields that",!?20,"point to other files."
Q
PTLIST ;
Q:^DD(ZDD,"B",NAME,NUMBER)=1 ;If this node equals 1 it is TITLE not NAME
S NODE0=^DD(ZDD,NUMBER,0) Q:$P(NODE0,U,2)'["P" Q:$P(NODE0,U,3)']""
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")
S CNT=CNT+1 I $Y>SIZE D PAGE Q:FLAGQ=1
Q
GL ;List Globals in ASCII order
D:'$D(^UTILITY("EDD/GL")) HELP
GLTOP D @$S($D(^UTILITY("EDD/GL")):"GLRANGE",1:"GLRANGE1") G:FLAGQ GLEX D INIT S HD="HD" D @HD
D GLLIST G:FLAGQ GLEX
GLEX ;Global Exit
K AA,BB,CNT,HD,TEMP,VAR,XXX
Q
GLRANGE ;Starting and Ending Global
I FLAGP W !?8,"Enter Global range...Include Starting & Ending Global:"
GLRANGE1 R !?8,"Starting Global: ^",AA:DTIME S:'$T!(AA="") AA="^" S:AA["^" FLAGQ=1 S:AA="^^" FLAGE=1 Q:FLAGQ
I AA="?"!(AA="*R") D:AA="?" HELP1 D:AA="*R" GLLOAD G GLRANGE
I '$D(^UTILITY("EDD/GL")) W *7," Enter '*R' to build your Global listing." G GLRANGE1
S AA=$S(AA="*":0,1:"^"_AA)
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
I FLAGP S TEMP=$O(^UTILITY("EDD/GL",AA)) I TEMP=""!(TEMP]BB) W *7," No globals in this range" G GLRANGE1
Q
GLLIST ;Start listing Globals
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
Q
GLLOAD ;
S AA=0,CNT=1 K ^UTILITY("EDD/GL")
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 "."
Q
HELP ;No data in ^UTILITY("EDD/GL")
W *7,?35,"You have no data in ^UTILITY(""EDD/GL"")."
W !?35,"You must first build your Global listing."
W !?35,"Enter '?' at the 'Starting Global:' prompt."
Q
HELP1 ;"Starting Global" prompt
W !!?8,"1. Enter Global you want listing to start with.",!?11,"Examples: ^DPT , ^L , or ^%ZIS."
W !?8,"2. Enter '*' to list all globals."
W !?8,"3. Enter '*R' to Build/Update your Global listing."
W !?14,"Your Global listing is kept in ^UTILITY(""EDD/GL""). If this is the"
W !?14,"first time you've used this utility, or if you have added or"
W !?14,"deleted any files on your system, enter '*R' here to build/update"
W !?14,"your listing. It will take approximately 30 seconds to run."
Q
PAGE ;
I FLAGP,IO'=IO(0) W @IOF,!!! D @HD Q
R !!?2,"<RETURN> to continue, '^' to quit, '^^' to exit: ",Z1:DTIME S:'$T Z1="^" I Z1["^" S FLAGQ=1 S:Z1="^^" FLAGE=1 Q
W @IOF D @HD
Q
HD ;
W !?2,"Globals in ASCII order:"
W !?10,"GLOBAL",?28,"FILE NUM",?46,"FILE (Truncated to 35)"
W !,?2,"----------------------",?27,"----------",?40,"-----------------------------------"
Q
HD1 ;Pointers from this file
W !?3,"Pointers FROM this file..",!?6,"FLD NUM",?26,"FIELD NAME",?52,"FILE (Truncated to 30)",!?6,"--------",?16,"------------------------------",?48,"------------------------------"
Q
INIT ;
I FLAGP,IO=IO(0),IOSL>25 D SCROLL^XBHEDD7 Q:FLAGQ
I FLAGP W:IO'=IO(0) " Printing.." U IO
W @IOF Q
XBHEDD10 ;402,DJB,10/23/91,EDD - Pointers From This File and Global Listing
+1 ;;2.6;IHS UTILITIES;;JUN 28, 1993
+2 ;;David Bolduc - Togus, ME
PT ;Pointers from this file
+1 DO INIT^XBHEDD7
SET HD="HD1"
DO @HD
DO PTGET
PTEX ;
+1 KILL CNT,NAME,NODE0,NUMBER,ZDD
+2 QUIT
PTGET ;
+1 SET ZDD=""
SET CNT=1
+2 FOR
SET ZDD=$ORDER(^UTILITY($JOB,"TMP",ZDD))
IF ZDD=""!(FLAGQ)
QUIT
SET NAME=""
FOR
SET NAME=$ORDER(^DD(ZDD,"B",NAME))
IF NAME=""
QUIT
SET NUMBER=""
SET NUMBER=$ORDER(^DD(ZDD,"B",NAME,""))
DO PTLIST
IF FLAGQ
QUIT
+3 IF CNT=1
WRITE !!!!!?20,"This file has no fields that",!?20,"point to other files."
+4 QUIT
PTLIST ;
+1 ;If this node equals 1 it is TITLE not NAME
IF ^DD(ZDD,"B",NAME,NUMBER)=1
QUIT
+2 SET NODE0=^DD(ZDD,NUMBER,0)
IF $PIECE(NODE0,U,2)'["P"
QUIT
IF $PIECE(NODE0,U,3)']""
QUIT
+3 WRITE !?1,$SELECT(ZDD'=ZNUM:"MULT",1:""),?6,$JUSTIFY(NUMBER,8),?16,NAME
SET FILE="^"_$PIECE(NODE0,U,3)_"0)"
WRITE ?48,$SELECT($DATA(@FILE):$EXTRACT($PIECE(@FILE,U),1,30),1:"-->No such file")
+4 SET CNT=CNT+1
IF $Y>SIZE
DO PAGE
IF FLAGQ=1
QUIT
+5 QUIT
GL ;List Globals in ASCII order
+1 IF '$DATA(^UTILITY("EDD/GL"))
DO HELP
GLTOP DO @$SELECT($DATA(^UTILITY("EDD/GL")):"GLRANGE",1:"GLRANGE1")
IF FLAGQ
GOTO GLEX
DO INIT
SET HD="HD"
DO @HD
+1 DO GLLIST
IF FLAGQ
GOTO GLEX
GLEX ;Global Exit
+1 KILL AA,BB,CNT,HD,TEMP,VAR,XXX
+2 QUIT
GLRANGE ;Starting and Ending Global
+1 IF FLAGP
WRITE !?8,"Enter Global range...Include Starting & Ending Global:"
GLRANGE1 READ !?8,"Starting Global: ^",AA:DTIME
IF '$TEST!(AA="")
SET AA="^"
IF AA["^"
SET FLAGQ=1
IF AA="^^"
SET FLAGE=1
IF FLAGQ
QUIT
+1 IF AA="?"!(AA="*R")
IF AA="?"
DO HELP1
IF AA="*R"
DO GLLOAD
GOTO GLRANGE
+2 IF '$DATA(^UTILITY("EDD/GL"))
WRITE *7," Enter '*R' to build your Global listing."
GOTO GLRANGE1
+3 SET AA=$SELECT(AA="*":0,1:"^"_AA)
+4 SET BB="^ZZZZZZZZZ"
IF FLAGP
READ !?8,"Ending Global: ^",BB:DTIME
IF '$TEST!(BB="")
SET BB="^"
IF BB="^"
GOTO GLRANGE
SET BB="^"_BB
IF BB']AA
WRITE *7," Ending Global must 'follow' Starting Global"
GOTO GLRANGE1
+5 IF FLAGP
SET TEMP=$ORDER(^UTILITY("EDD/GL",AA))
IF TEMP=""!(TEMP]BB)
WRITE *7," No globals in this range"
GOTO GLRANGE1
+6 QUIT
GLLIST ;Start listing Globals
+1 FOR
SET AA=$ORDER(^UTILITY("EDD/GL",AA))
IF AA=""!(AA]BB)
QUIT
WRITE !?2,AA,?23,$JUSTIFY($PIECE(^(AA),U),14),?40,$EXTRACT($PIECE(^(AA),U,2),1,35)
IF $Y>SIZE
DO PAGE
IF FLAGQ
QUIT
+2 QUIT
GLLOAD ;
+1 SET AA=0
SET CNT=1
KILL ^UTILITY("EDD/GL")
+2 FOR
SET AA=$ORDER(^DIC(AA))
IF AA'>0
QUIT
IF $DATA(^DIC(AA,0,"GL"))
SET ^UTILITY("EDD/GL",^DIC(AA,0,"GL"))=AA_"^"_$PIECE(^DIC(AA,0),"^")
WRITE "."
+3 QUIT
HELP ;No data in ^UTILITY("EDD/GL")
+1 WRITE *7,?35,"You have no data in ^UTILITY(""EDD/GL"")."
+2 WRITE !?35,"You must first build your Global listing."
+3 WRITE !?35,"Enter '?' at the 'Starting Global:' prompt."
+4 QUIT
HELP1 ;"Starting Global" prompt
+1 WRITE !!?8,"1. Enter Global you want listing to start with.",!?11,"Examples: ^DPT , ^L , or ^%ZIS."
+2 WRITE !?8,"2. Enter '*' to list all globals."
+3 WRITE !?8,"3. Enter '*R' to Build/Update your Global listing."
+4 WRITE !?14,"Your Global listing is kept in ^UTILITY(""EDD/GL""). If this is the"
+5 WRITE !?14,"first time you've used this utility, or if you have added or"
+6 WRITE !?14,"deleted any files on your system, enter '*R' here to build/update"
+7 WRITE !?14,"your listing. It will take approximately 30 seconds to run."
+8 QUIT
PAGE ;
+1 IF FLAGP
IF IO'=IO(0)
WRITE @IOF,!!!
DO @HD
QUIT
+2 READ !!?2,"<RETURN> to continue, '^' to quit, '^^' to exit: ",Z1:DTIME
IF '$TEST
SET Z1="^"
IF Z1["^"
SET FLAGQ=1
IF Z1="^^"
SET FLAGE=1
QUIT
+3 WRITE @IOF
DO @HD
+4 QUIT
HD ;
+1 WRITE !?2,"Globals in ASCII order:"
+2 WRITE !?10,"GLOBAL",?28,"FILE NUM",?46,"FILE (Truncated to 35)"
+3 WRITE !,?2,"----------------------",?27,"----------",?40,"-----------------------------------"
+4 QUIT
HD1 ;Pointers from this file
+1 WRITE !?3,"Pointers FROM this file..",!?6,"FLD NUM",?26,"FIELD NAME",?52,"FILE (Truncated to 30)",!?6,"--------",?16,"------------------------------",?48,"------------------------------"
+2 QUIT
INIT ;
+1 IF FLAGP
IF IO=IO(0)
IF IOSL>25
DO SCROLL^XBHEDD7
IF FLAGQ
QUIT
+2 IF FLAGP
IF IO'=IO(0)
WRITE " Printing.."
USE IO
+3 WRITE @IOF
QUIT
