1 | XBHEDD3 ;402,DJB,10/23/91,EDD - Individual Field Summary
|
---|
2 | ;;4.0;XB;;Jul 20, 2009;Build 2
|
---|
3 | ;;David Bolduc - Togus,ME
|
---|
4 | N CNT,DATA,FILE,FNAM,FNUM,LEV,TEMP
|
---|
5 | D INIT I FLAGP D HD
|
---|
6 | F D GETFLD Q:'LEV!FLAGE
|
---|
7 | I FLAGP,$D(^UTILITY($J,"INDIV")) D PRINT
|
---|
8 | EX ;
|
---|
9 | K DIC,^UTILITY($J,"INDIV") S FLAGQ=1 Q
|
---|
10 | GETFLD ;Field lookup. Var LEV increments and decrements with Multiple layers.
|
---|
11 | S DIC="^DD("_FILE(LEV)_"," D ^DIC I Y<0 S LEV=LEV-1 Q
|
---|
12 | S FNUM=+Y,FNAM=$P(Y,U,2),TEMP=+$P(^DD(FILE(LEV),FNUM,0),U,2)
|
---|
13 | I TEMP S LEV=LEV+1,FILE(LEV)=TEMP Q
|
---|
14 | I 'FLAGP D ^XBHEDD4 Q
|
---|
15 | S ^UTILITY($J,"INDIV",CNT)=FILE(LEV)_"^"_FNUM_"^"_FNAM,CNT=CNT+1
|
---|
16 | Q
|
---|
17 | PRINT ;
|
---|
18 | W:IO'=IO(0) " Printing.." U IO D TXT^XBHEDD7
|
---|
19 | S CNT="" F S CNT=$O(^UTILITY($J,"INDIV",CNT)) Q:CNT="" S DATA=^UTILITY($J,"INDIV",CNT),FILE(LEV)=$P(DATA,U),FNUM=$P(DATA,U,2),FNAM=$P(DATA,U,3) D ^XBHEDD4 Q:FLAGQ W !!,$E(ZLINE2,1,IOM),!!
|
---|
20 | Q
|
---|
21 | HD ;
|
---|
22 | W @IOF,!,$E(ZLINE1,1,80),!?5,"Enter one at a time, as many fields as you wish to print. Fields will",!?5,"print in the order entered.",!,$E(ZLINE1,1,80),!
|
---|
23 | Q
|
---|
24 | INIT ;
|
---|
25 | S (CNT,LEV)=1,FILE(LEV)=ZNUM K ^UTILITY($J,"INDIV")
|
---|
26 | S DIC(0)="QEAM",DIC("W")="I $P(^DD(FILE(LEV),Y,0),U,2)>0 W "" -->Mult Fld"""
|
---|
27 | Q
|
---|