source: IHS-VA_UTILITIES-XB/trunk/XBHEDD8.m@ 1619

Last change on this file since 1619 was 642, checked in by Sam Habiel, 15 years ago

Modified directory structure; moved routines.

File size: 2.4 KB
Line 
1XBHEDD8 ;402,DJB,10/23/91,EDD - Trace a Field
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;;David Bolduc - Togus, ME
4EN ;
5 I FLAGP D PRINT^XBHEDD7 ;Turn off printing
6 D GETFLD G:FLAGQ EX D LIST G:FLAGG!(FLAGE) EX
7 D TRACE G:FLAGQ EX D PRINT,ASK
8EX K CNT,DATA,FLD,FLD1,FLDCNT,I,LEVEL,MAR,MAR1,ZDD,ZNAME,ZNUMBER,^UTILITY($J,"FLD")
9 S FLAGQ=1 Q
10GETFLD ;
11 R !?8,"Enter Field Name: ALL FIELDS//",FLD:DTIME S:'$T FLD="^^" I FLD["^" S FLAGQ=1 S:FLD="^^" FLAGE=1 Q
12 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
13 Q
14LIST ;
15 S ZDD="",FLDCNT=1
16 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
17 I '$D(^UTILITY($J,"FLD")) W ?50,"No such field." S FLAGG=1
18 S FLAGQ=0 Q
19LIST1 ;
20 S ZNUMBER=$O(^DD(ZDD,"B",ZNAME,"")) Q:^DD(ZDD,"B",ZNAME,ZNUMBER)=1
21 D:FLDCNT=1 HD
22 W ! W:$P(^DD(ZDD,ZNUMBER,0),U,2)>0 "Mult->" W ?6,$J(FLDCNT,3),".",?LEVEL*5+6," ",ZNAME," (",ZNUMBER,")"
23 S ^UTILITY($J,"FLD",FLDCNT)=ZNAME_"^"_ZDD_"^"_ZNUMBER_"^"_LEVEL
24 D:$Y>SIZE PAGE Q:FLAGQ
25 S FLDCNT=FLDCNT+1
26 Q
27TRACE ;If more than one match do NUM
28 R !!?8,"Select Number: ",FLD1:DTIME S:'$T FLD1="^^" S:FLD1="" FLD1="^" I FLD1["^" S FLAGQ=1 S:FLD1="^^" FLAGE=1 Q
29 I FLD1<1!(FLD1>(FLDCNT)) W *7,!?2,"Enter a number from the left hand column." G TRACE
30 S CNT=1,ZNAME(CNT)=$P(^UTILITY($J,"FLD",FLD1),U),ZNUMBER(CNT)=$P(^(FLD1),U,3),ZDD=$P(^(FLD1),U,2)
31 Q:ZDD=ZNUM
32 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
33 Q
34PRINT ;Print data.
35 W @IOF,!!!,?IOM\2-11,"F I E L D T R A C E",!,$E(ZLINE1,1,IOM)
36 S MAR=5,MAR1=15
37 F W !!?MAR,ZNUMBER(CNT),?MAR1,ZNAME(CNT) S CNT=CNT-1 Q:CNT=0 S MAR=MAR+5,MAR1=MAR1+5
38 Q
39ASK ;
40 I $Y'>SIZE F I=$Y:1:SIZE W !
41 W !,$E(ZLINE1,1,IOM)
42 W !?2,"(<RETURN>=Main Menu) ('I'=Individual Field Summary)"
43ASK1 R !?2,"Select: ",Z1:DTIME S:'$T Z1="^^" I Z1="^^" S FLAGE=1
44 I Z1="?" W *7,!?2,"See menu on line above." G ASK1
45 S:Z1="i" Z1="I" I Z1="I" D ^XBHEDD3
46 Q
47PAGE ;
48 R !!?2,"<RETURN> to continue, '^' to quit, '^^' to exit: ",Z1:DTIME S:'$T Z1="^" I Z1["^" S FLAGQ=1 S:Z1="^^" FLAGE=1 Q
49 D HD Q
50HD ;Trace a field
51 W @IOF,!!,"MULTIPLE",?13,"1 2 3 4 5 6 7",!,"LEVELS",?13,"| | | | | | |",!,$E(ZLINE,1,IOM),!
52 Q
Note: See TracBrowser for help on using the repository browser.