source: IHS-VA_UTILITIES-XB/trunk/XBHEDD3.m@ 856

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

Modified directory structure; moved routines.

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.