source: IHS-VA_UTILITIES-XB/trunk/XBHEDD6.m@ 973

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

Modified directory structure; moved routines.

File size: 3.1 KB
Line 
1XBHEDD6 ;402,DJB,10/23/91,EDD - Xref,Groups,Pointers In
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;; David Bolduc - Togus, ME
4XREF ;Cross Reference Listing
5 I '$D(^DD(ZNUM,0,"IX")) W ?30,"No XREF for this file." S FLAGG=1 Q
6 S NM="",HD="HD1" D INIT^XBHEDD7 G:FLAGQ EX D HD1
7 F S NM=$O(^DD(ZNUM,0,"IX",NM)) Q:NM="" D:$Y>SIZE PAGE Q:FLAGQ S ZDD="",ZDD=$O(^DD(ZNUM,0,"IX",NM,ZDD)),ZFLD="",ZFLD=$O(^DD(ZNUM,0,"IX",NM,ZDD,ZFLD)) D XREFPRT
8 G EX
9XREFPRT ;
10 S GLTEMP=ZGL_""""_NM_""""_")"
11 W ! W:$D(@(GLTEMP)) ?1,"*" W ?4,"""",NM,"""",?22,$J(ZDD,8),?33,$J(ZFLD,10)
12 I $D(^DD(ZDD,ZFLD,0)) W ?46,$P(^(0),U) Q
13 W ?46,"---> Field doesn't exist"
14 Q
15PT ;Pointers to this file
16 I '$D(^DD(ZNUM,0,"PT")) W ?30,"No files point to this file." S FLAGG=1 Q
17 D INIT^XBHEDD7 G:FLAGQ EX D HD3 S ZFILE="",ZCNT=1,HD="HD3"
18 F S ZFILE=$O(^DD(ZNUM,0,"PT",ZFILE)) Q:ZFILE=""!FLAGQ S FLAGPT=0 D @$S($D(^DIC(ZFILE,0)):"PTYES",1:"PTNO") I 'FLAGPT S ZFLD="" F S ZFLD=$O(^DD(ZNUM,0,"PT",ZFILE,ZFLD)) Q:ZFLD="" D PTPRT Q:FLAGQ
19 G EX
20PTNO ;
21 I '$D(^DD(ZFILE,0,"UP")) S FLAGPT=1 Q
22 S ZFILETP=ZFILE F S ZFILETP=^DD(ZFILETP,0,"UP") Q:$D(^DIC(ZFILETP,0)) I '$D(^DD(ZFILETP,0,"UP")) Q
23 I '$D(^DIC(ZFILETP,0)) S FLAGPT=1 Q
24 S GL=^DIC(ZFILETP,0,"GL"),ZFILEN=$P(^DIC(ZFILETP,0),U)
25 Q
26PTYES ;
27 S GL=^DIC(ZFILE,0,"GL"),ZFILEN=$P(^DIC(ZFILE,0),U) Q
28PTPRT ;
29 W !,$J(ZCNT,4),".",?6,GL,?21,$E(ZFILEN,1,25)
30 W ?48 I $D(^DD(ZFILE,ZFLD,0)),$P(^(0),U)]"" W $E($P(^(0),U),1,22)," (",ZFLD,")"
31 E W "--> Field ",ZFLD," does not exist."
32 S ZCNT=ZCNT+1 I $Y>SIZE D PAGE Q:FLAGQ
33 Q
34GRP ;Groups
35 S ZMULT="",HD="HD2" D GRPBLD G:FLAGG EX D INIT^XBHEDD7 G:FLAGQ EX D HD2,GRPPRT
36 G EX
37GRPBLD ;
38 S Z="",X=1
39 F S Z=$O(^UTILITY($J,"TMP",Z)) Q:Z="" I $D(^DD(Z,"GR")) S GRP="" F S GRP=$O(^DD(Z,"GR",GRP)) Q:GRP="" S ZFLD="" F S ZFLD=$O(^DD(Z,"GR",GRP,ZFLD)) Q:ZFLD="" S ^UTILITY($J,"GROUP",GRP,Z,ZFLD)=$P(^DD(Z,ZFLD,0),U),X=X+1 I X#9=0 W "."
40 I '$D(^UTILITY($J,"GROUP")) W ?30,"No Groups established." S FLAGG=1
41 Q
42GRPPRT ;
43 S GRP="" F I=1:1 S GRP=$O(^UTILITY($J,"GROUP",GRP)) Q:GRP=""!FLAGQ W !,$J(I,3),". ",GRP D GRPPRT1
44 Q
45GRPPRT1 ;
46 S GRP1=""
47 F S GRP1=$O(^UTILITY($J,"GROUP",GRP,GRP1)) Q:GRP1=""!FLAGQ S GRP2="" F S GRP2=$O(^UTILITY($J,"GROUP",GRP,GRP1,GRP2)) Q:GRP2="" W ?18,$J(GRP1,6),?27,$J(GRP2,8),?39,^(GRP2),! I $Y>SIZE D PAGE Q:FLAGQ
48 Q
49EX ;
50 K FLAGPT,GL,GLTEMP,GRP,GRP1,GRP2,HD,NM,ZDD,ZFILE,ZFILEN,ZFILETP,ZFLD,ZGL1,ZMULT
51 K ^UTILITY($J,"GROUP") Q
52HD1 ;XREF
53 W !?9,"XREF",?25,"DD",?34,"FLD NUM",?56,"FIELD NAME",!?4,"---------------",?22,"--------",?33,"----------",?46,"------------------------------"
54 Q
55HD2 ;Groups
56 W !?5,"GROUP NAME",?20,"DD",?27,"FLD NUM",?48,"FIELD NAME",!?5,"-----------",?18,"------",?27,"--------",?39,"------------------------------",!
57 Q
58HD3 ;Pointers to this file
59 W !?3,"Pointers TO this file..",!?9,"GLOBAL",?22,"FILE (Truncated to 25)",?50,"FIELD (Truncated to 22)",!?6,"-------------",?21,"-------------------------",?48,"------------------------------"
60 Q
61PAGE ;
62 I FLAGP,IO'=IO(0) W @IOF,!!! D @HD Q
63 R !!?2,"<RETURN> to continue, '^' to quit, '^^' to exit: ",Z1:DTIME S:'$T Z1="^" I Z1["^" S FLAGQ=1 S:Z1="^^" FLAGE=1 Q
64 W @IOF D @HD
65 Q
Note: See TracBrowser for help on using the repository browser.