source: IHS-VA_UTILITIES-XB/XBHEDD3.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: 1.1 KB
Line 
1XBHEDD3 ;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
8EX ;
9 K DIC,^UTILITY($J,"INDIV") S FLAGQ=1 Q
10GETFLD ;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
17PRINT ;
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
21HD ;
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
24INIT ;
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
Note: See TracBrowser for help on using the repository browser.