XBHEDD1 ;402,DJB,10/23/91,EDD - FIELD Global Locations
;;2.6;IHS UTILITIES;;JUN 28, 1993
;;David Bolduc - Togus, ME
PRINT ;Called by START,LOOP
Q:'$D(^DD(FILE(LEVEL),FLD(LEVEL),0))
S ZDATA=^DD(FILE(LEVEL),FLD(LEVEL),0),ZZA=$S($P(ZDATA,U,4)=" ; ":"Computed",1:$P(ZDATA,U,4)),ZZB=$P(ZDATA,U)
W !?2,$J(ZZA,12),?17,$J(FLD(LEVEL),8),?28,DASHES,ZZB
S ZY1=$P($P(ZDATA,U,4),";",2) W:ZY1=0 ?70,"-->Mult"
S ZMZ=" " I ZY1=0 F II=1:1:41-$L(DASHES_ZZB) S ZMZ=ZMZ_" "
I S ZMZ=ZMZ_"-->Mult"
I 'FLAGP S ^UTILITY($J,"LIST",PAGE,YCNT)=ZZA_"^"_FLD(LEVEL)_"^"_DASHES_ZZB_ZMZ
S YCNT=YCNT+1
Q
EN ;Entry Point
D ASK G:FLAGQ EX
I FLAGP,IO'=IO(0),^UTILITY($J,"TOT")>100 D WARN G:FLAGQ EX
S HD="HD" D INIT^XBHEDD7 G:FLAGQ EX D @HD D START,LOOP
EX ;
I FLAGQ!FLAGE!FLAGP S:IO'=IO(0) FLAGQ=1 D KILL Q
S FLAGL=1 D ^XBHEDD2 S:'FLAGQ FLAGQ=1 D KILL
Q
ASK ;
W !?26,"""F""........ to select starting FIELD",!?26,"<RETURN>... for all fields"
ASK1 W !?30,"Select: ALL// " R ZZX:DTIME S:'$T ZZX="^" I ZZX["^" S FLAGQ=1 S:ZZX="^^" FLAGE=1 Q
I ZZX="?" W !?10,"Type ""^"" to quit",!?10,"<RETURN> to see all fields",!?10,"""F"" to start listing at a particular field" G ASK1
S (LEVEL,PAGE,YCNT)=1,FILE(LEVEL)=ZNUM,DASHES=""
I ZZX="F" W ! S DIC="^DD("_ZNUM_",",DIC(0)="QEAM",DIC("W")="I $P(^DD(ZNUM,Y,0),U,2)>0 W ?65,"" -->Mult""" D ^DIC K DIC("W") S:Y<0 FLAGQ=1 Q:Y<0 S FLD(LEVEL)=+Y
E S FLD(LEVEL)=0
Q
START ;Print if data, otherwise continue to loop.
I $D(^DD(FILE(LEVEL),FLD(LEVEL),0))#2 D PRINT I ZY1=0 S LEVEL=LEVEL+1,FILE(LEVEL)=+$P(ZDATA,U,2),FLD(LEVEL)=0
Q
LOOP ;Start For Loop
S FLD(LEVEL)=$O(^DD(FILE(LEVEL),FLD(LEVEL))) I +FLD(LEVEL)=0 S LEVEL=LEVEL-1 G:LEVEL LOOP Q
S (SPACE,BAR)=""
F II=1:1:LEVEL-1 S SPACE=SPACE_" ",BAR=BAR_"-"
S DASHES=SPACE_BAR
D PRINT I ZY1=0 S LEVEL=LEVEL+1,FILE(LEVEL)=+$P(ZDATA,U,2),FLD(LEVEL)=0
I $Y>SIZE D:'FLAGP ^XBHEDD2 Q:FLAGQ I FLAGP D PAUSE Q:FLAGQ W @IOF W:IO'=IO(0) !!! D HD
G LOOP
PAUSE ;
Q:IO'=IO(0)
W !!?2,"<RETURN> to continue, '^' to quit: "
R Z1:DTIME S:'$T Z1="^^" I Z1["^" S FLAGQ=1 S:Z1="^^" FLAGE=1
Q
WARN ;Warn if printing and over 100 fields in file
W !?8,"This file has over 100 fields. Sure you want to print? YES//"
R XX:DTIME S:'$T XX="N" S:"Yy"'[$E(XX) FLAGQ=1 I XX="?" W !?2,"[Y]es to print, [N]o to return to Main Menu." G WARN
Q
HD ;
W !?2,"NODE ; PIECE",?17,"FLD NUM",?48,"FIELD NAME",!?2,"------------",?17,"--------",?28,"-------------------------------------------------"
Q
KILL ;Kill variables
K DASHES,EDDDATE,FILE,HD,LEVEL,PAGE,PAGETEMP,YCNT,^UTILITY($J,"LIST")
Q
XBHEDD1 ;402,DJB,10/23/91,EDD - FIELD Global Locations
+1 ;;2.6;IHS UTILITIES;;JUN 28, 1993
+2 ;;David Bolduc - Togus, ME
PRINT ;Called by START,LOOP
+1 IF '$DATA(^DD(FILE(LEVEL),FLD(LEVEL),0))
QUIT
+2 SET ZDATA=^DD(FILE(LEVEL),FLD(LEVEL),0)
SET ZZA=$SELECT($PIECE(ZDATA,U,4)=" ; ":"Computed",1:$PIECE(ZDATA,U,4))
SET ZZB=$PIECE(ZDATA,U)
+3 WRITE !?2,$JUSTIFY(ZZA,12),?17,$JUSTIFY(FLD(LEVEL),8),?28,DASHES,ZZB
+4 SET ZY1=$PIECE($PIECE(ZDATA,U,4),";",2)
IF ZY1=0
WRITE ?70,"-->Mult"
+5 SET ZMZ=" "
IF ZY1=0
FOR II=1:1:41-$LENGTH(DASHES_ZZB)
SET ZMZ=ZMZ_" "
+6 IF $TEST
SET ZMZ=ZMZ_"-->Mult"
+7 IF 'FLAGP
SET ^UTILITY($JOB,"LIST",PAGE,YCNT)=ZZA_"^"_FLD(LEVEL)_"^"_DASHES_ZZB_ZMZ
+8 SET YCNT=YCNT+1
+9 QUIT
EN ;Entry Point
+1 DO ASK
IF FLAGQ
GOTO EX
+2 IF FLAGP
IF IO'=IO(0)
IF ^UTILITY($JOB,"TOT")>100
DO WARN
IF FLAGQ
GOTO EX
+3 SET HD="HD"
DO INIT^XBHEDD7
IF FLAGQ
GOTO EX
DO @HD
DO START
DO LOOP
EX ;
+1 IF FLAGQ!FLAGE!FLAGP
IF IO'=IO(0)
SET FLAGQ=1
DO KILL
QUIT
+2 SET FLAGL=1
DO ^XBHEDD2
IF 'FLAGQ
SET FLAGQ=1
DO KILL
+3 QUIT
ASK ;
+1 WRITE !?26,"""F""........ to select starting FIELD",!?26,"<RETURN>... for all fields"
ASK1 WRITE !?30,"Select: ALL// "
READ ZZX:DTIME
IF '$TEST
SET ZZX="^"
IF ZZX["^"
SET FLAGQ=1
IF ZZX="^^"
SET FLAGE=1
QUIT
+1 IF ZZX="?"
WRITE !?10,"Type ""^"" to quit",!?10,"<RETURN> to see all fields",!?10,"""F"" to start listing at a particular field"
GOTO ASK1
+2 SET (LEVEL,PAGE,YCNT)=1
SET FILE(LEVEL)=ZNUM
SET DASHES=""
+3 IF ZZX="F"
WRITE !
SET DIC="^DD("_ZNUM_","
SET DIC(0)="QEAM"
SET DIC("W")="I $P(^DD(ZNUM,Y,0),U,2)>0 W ?65,"" -->Mult"""
DO ^DIC
KILL DIC("W")
IF Y<0
SET FLAGQ=1
IF Y<0
QUIT
SET FLD(LEVEL)=+Y
+4 IF '$TEST
SET FLD(LEVEL)=0
+5 QUIT
START ;Print if data, otherwise continue to loop.
+1 IF $DATA(^DD(FILE(LEVEL),FLD(LEVEL),0))#2
DO PRINT
IF ZY1=0
SET LEVEL=LEVEL+1
SET FILE(LEVEL)=+$PIECE(ZDATA,U,2)
SET FLD(LEVEL)=0
+2 QUIT
LOOP ;Start For Loop
+1 SET FLD(LEVEL)=$ORDER(^DD(FILE(LEVEL),FLD(LEVEL)))
IF +FLD(LEVEL)=0
SET LEVEL=LEVEL-1
IF LEVEL
GOTO LOOP
QUIT
+2 SET (SPACE,BAR)=""
+3 FOR II=1:1:LEVEL-1
SET SPACE=SPACE_" "
SET BAR=BAR_"-"
+4 SET DASHES=SPACE_BAR
+5 DO PRINT
IF ZY1=0
SET LEVEL=LEVEL+1
SET FILE(LEVEL)=+$PIECE(ZDATA,U,2)
SET FLD(LEVEL)=0
+6 IF $Y>SIZE
IF 'FLAGP
DO ^XBHEDD2
IF FLAGQ
QUIT
IF FLAGP
DO PAUSE
IF FLAGQ
QUIT
WRITE @IOF
IF IO'=IO(0)
WRITE !!!
DO HD
+7 GOTO LOOP
PAUSE ;
+1 IF IO'=IO(0)
QUIT
+2 WRITE !!?2,"<RETURN> to continue, '^' to quit: "
+3 READ Z1:DTIME
IF '$TEST
SET Z1="^^"
IF Z1["^"
SET FLAGQ=1
IF Z1="^^"
SET FLAGE=1
+4 QUIT
WARN ;Warn if printing and over 100 fields in file
+1 WRITE !?8,"This file has over 100 fields. Sure you want to print? YES//"
+2 READ XX:DTIME
IF '$TEST
SET XX="N"
IF "Yy"'[$EXTRACT(XX)
SET FLAGQ=1
IF XX="?"
WRITE !?2,"[Y]es to print, [N]o to return to Main Menu."
GOTO WARN
+3 QUIT
HD ;
+1 WRITE !?2,"NODE ; PIECE",?17,"FLD NUM",?48,"FIELD NAME",!?2,"------------",?17,"--------",?28,"-------------------------------------------------"
+2 QUIT
KILL ;Kill variables
+1 KILL DASHES,EDDDATE,FILE,HD,LEVEL,PAGE,PAGETEMP,YCNT,^UTILITY($JOB,"LIST")
+2 QUIT
