XBHEDD8 ;402,DJB,10/23/91,EDD - Trace a Field
;;2.6;IHS UTILITIES;;JUN 28, 1993
;;David Bolduc - Togus, ME
EN ;
I FLAGP D PRINT^XBHEDD7 ;Turn off printing
D GETFLD G:FLAGQ EX D LIST G:FLAGG!(FLAGE) EX
D TRACE G:FLAGQ EX D PRINT,ASK
EX K CNT,DATA,FLD,FLD1,FLDCNT,I,LEVEL,MAR,MAR1,ZDD,ZNAME,ZNUMBER,^UTILITY($J,"FLD")
S FLAGQ=1 Q
GETFLD ;
R !?8,"Enter Field Name: ALL FIELDS//",FLD:DTIME S:'$T FLD="^^" I FLD["^" S FLAGQ=1 S:FLD="^^" FLAGE=1 Q
I FLD="?" W !?2,"Enter field name or any portion of name. I will display the field's path.",!?2,"Use this option if you get ""beeped"" in the INDIVIDUAL FIELD SUMMARY because",!?2,"the field is decendent from a multiple." G GETFLD
Q
LIST ;
S ZDD="",FLDCNT=1
F S ZDD=$O(^UTILITY($J,"TMP",ZDD)) Q:ZDD=""!(FLAGQ) S LEVEL=$P(^(ZDD),U,2),ZNAME="" F S ZNAME=$O(^DD(ZDD,"B",ZNAME)) Q:ZNAME="" I $E(ZNAME,1,$L(FLD))=FLD D LIST1 Q:FLAGQ
I '$D(^UTILITY($J,"FLD")) W ?50,"No such field." S FLAGG=1
S FLAGQ=0 Q
LIST1 ;
S ZNUMBER=$O(^DD(ZDD,"B",ZNAME,"")) Q:^DD(ZDD,"B",ZNAME,ZNUMBER)=1
D:FLDCNT=1 HD
W ! W:$P(^DD(ZDD,ZNUMBER,0),U,2)>0 "Mult->" W ?6,$J(FLDCNT,3),".",?LEVEL*5+6," ",ZNAME," (",ZNUMBER,")"
S ^UTILITY($J,"FLD",FLDCNT)=ZNAME_"^"_ZDD_"^"_ZNUMBER_"^"_LEVEL
D:$Y>SIZE PAGE Q:FLAGQ
S FLDCNT=FLDCNT+1
Q
TRACE ;If more than one match do NUM
R !!?8,"Select Number: ",FLD1:DTIME S:'$T FLD1="^^" S:FLD1="" FLD1="^" I FLD1["^" S FLAGQ=1 S:FLD1="^^" FLAGE=1 Q
I FLD1<1!(FLD1>(FLDCNT)) W *7,!?2,"Enter a number from the left hand column." G TRACE
S CNT=1,ZNAME(CNT)=$P(^UTILITY($J,"FLD",FLD1),U),ZNUMBER(CNT)=$P(^(FLD1),U,3),ZDD=$P(^(FLD1),U,2)
Q:ZDD=ZNUM
F S CNT=CNT+1,ZNUMBER(CNT)=$P(^UTILITY($J,"TMP",ZDD),U,3),ZDD=^DD(ZDD,0,"UP"),ZNAME(CNT)=$P(^DD(ZDD,ZNUMBER(CNT),0),U) Q:ZDD=ZNUM
Q
PRINT ;Print data.
W @IOF,!!!,?IOM\2-11,"F I E L D T R A C E",!,$E(ZLINE1,1,IOM)
S MAR=5,MAR1=15
F W !!?MAR,ZNUMBER(CNT),?MAR1,ZNAME(CNT) S CNT=CNT-1 Q:CNT=0 S MAR=MAR+5,MAR1=MAR1+5
Q
ASK ;
I $Y'>SIZE F I=$Y:1:SIZE W !
W !,$E(ZLINE1,1,IOM)
W !?2,"(<RETURN>=Main Menu) ('I'=Individual Field Summary)"
ASK1 R !?2,"Select: ",Z1:DTIME S:'$T Z1="^^" I Z1="^^" S FLAGE=1
I Z1="?" W *7,!?2,"See menu on line above." G ASK1
S:Z1="i" Z1="I" I Z1="I" D ^XBHEDD3
Q
PAGE ;
R !!?2,"<RETURN> to continue, '^' to quit, '^^' to exit: ",Z1:DTIME S:'$T Z1="^" I Z1["^" S FLAGQ=1 S:Z1="^^" FLAGE=1 Q
D HD Q
HD ;Trace a field
W @IOF,!!,"MULTIPLE",?13,"1 2 3 4 5 6 7",!,"LEVELS",?13,"| | | | | | |",!,$E(ZLINE,1,IOM),!
Q
XBHEDD8 ;402,DJB,10/23/91,EDD - Trace a Field
+1 ;;2.6;IHS UTILITIES;;JUN 28, 1993
+2 ;;David Bolduc - Togus, ME
EN ;
+1 ;Turn off printing
IF FLAGP
DO PRINT^XBHEDD7
+2 DO GETFLD
IF FLAGQ
GOTO EX
DO LIST
IF FLAGG!(FLAGE)
GOTO EX
+3 DO TRACE
IF FLAGQ
GOTO EX
DO PRINT
DO ASK
EX KILL CNT,DATA,FLD,FLD1,FLDCNT,I,LEVEL,MAR,MAR1,ZDD,ZNAME,ZNUMBER,^UTILITY($JOB,"FLD")
+1 SET FLAGQ=1
QUIT
GETFLD ;
+1 READ !?8,"Enter Field Name: ALL FIELDS//",FLD:DTIME
IF '$TEST
SET FLD="^^"
IF FLD["^"
SET FLAGQ=1
IF FLD="^^"
SET FLAGE=1
QUIT
+2 IF FLD="?"
WRITE !?2,"Enter field name or any portion of name. I will display the field's path.",!?2,"Use this option if you get ""beeped"" in the INDIVIDUAL FIELD SUMMARY because",!?2,"the field is decendent from a multiple."
GOTO GETFLD
+3 QUIT
LIST ;
+1 SET ZDD=""
SET FLDCNT=1
+2 FOR
SET ZDD=$ORDER(^UTILITY($JOB,"TMP",ZDD))
IF ZDD=""!(FLAGQ)
QUIT
SET LEVEL=$PIECE(^(ZDD),U,2)
SET ZNAME=""
FOR
SET ZNAME=$ORDER(^DD(ZDD,"B",ZNAME))
IF ZNAME=""
QUIT
IF $EXTRACT(ZNAME,1,$LENGTH(FLD))=FLD
DO LIST1
IF FLAGQ
QUIT
+3 IF '$DATA(^UTILITY($JOB,"FLD"))
WRITE ?50,"No such field."
SET FLAGG=1
+4 SET FLAGQ=0
QUIT
LIST1 ;
+1 SET ZNUMBER=$ORDER(^DD(ZDD,"B",ZNAME,""))
IF ^DD(ZDD,"B",ZNAME,ZNUMBER)=1
QUIT
+2 IF FLDCNT=1
DO HD
+3 WRITE !
IF $PIECE(^DD(ZDD,ZNUMBER,0),U,2)>0
WRITE "Mult->"
WRITE ?6,$JUSTIFY(FLDCNT,3),".",?LEVEL*5+6," ",ZNAME," (",ZNUMBER,")"
+4 SET ^UTILITY($JOB,"FLD",FLDCNT)=ZNAME_"^"_ZDD_"^"_ZNUMBER_"^"_LEVEL
+5 IF $Y>SIZE
DO PAGE
IF FLAGQ
QUIT
+6 SET FLDCNT=FLDCNT+1
+7 QUIT
TRACE ;If more than one match do NUM
+1 READ !!?8,"Select Number: ",FLD1:DTIME
IF '$TEST
SET FLD1="^^"
IF FLD1=""
SET FLD1="^"
IF FLD1["^"
SET FLAGQ=1
IF FLD1="^^"
SET FLAGE=1
QUIT
+2 IF FLD1<1!(FLD1>(FLDCNT))
WRITE *7,!?2,"Enter a number from the left hand column."
GOTO TRACE
+3 SET CNT=1
SET ZNAME(CNT)=$PIECE(^UTILITY($JOB,"FLD",FLD1),U)
SET ZNUMBER(CNT)=$PIECE(^(FLD1),U,3)
SET ZDD=$PIECE(^(FLD1),U,2)
+4 IF ZDD=ZNUM
QUIT
+5 FOR
SET CNT=CNT+1
SET ZNUMBER(CNT)=$PIECE(^UTILITY($JOB,"TMP",ZDD),U,3)
SET ZDD=^DD(ZDD,0,"UP")
SET ZNAME(CNT)=$PIECE(^DD(ZDD,ZNUMBER(CNT),0),U)
IF ZDD=ZNUM
QUIT
+6 QUIT
PRINT ;Print data.
+1 WRITE @IOF,!!!,?IOM\2-11,"F I E L D T R A C E",!,$EXTRACT(ZLINE1,1,IOM)
+2 SET MAR=5
SET MAR1=15
+3 FOR
WRITE !!?MAR,ZNUMBER(CNT),?MAR1,ZNAME(CNT)
SET CNT=CNT-1
IF CNT=0
QUIT
SET MAR=MAR+5
SET MAR1=MAR1+5
+4 QUIT
ASK ;
+1 IF $Y'>SIZE
FOR I=$Y:1:SIZE
WRITE !
+2 WRITE !,$EXTRACT(ZLINE1,1,IOM)
+3 WRITE !?2,"(<RETURN>=Main Menu) ('I'=Individual Field Summary)"
ASK1 READ !?2,"Select: ",Z1:DTIME
IF '$TEST
SET Z1="^^"
IF Z1="^^"
SET FLAGE=1
+1 IF Z1="?"
WRITE *7,!?2,"See menu on line above."
GOTO ASK1
+2 IF Z1="i"
SET Z1="I"
IF Z1="I"
DO ^XBHEDD3
+3 QUIT
PAGE ;
+1 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
+2 DO HD
QUIT
HD ;Trace a field
+1 WRITE @IOF,!!,"MULTIPLE",?13,"1 2 3 4 5 6 7",!,"LEVELS",?13,"| | | | | | |",!,$EXTRACT(ZLINE,1,IOM),!
+2 QUIT
