source: IHS-VA_UTILITIES-XB/XBHEDD8.m@ 641

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

Initial commit of XB, move away from sf.net.
Includes kids file and documentation.

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.