- 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
