| 1 | XBHEDD6 ;402,DJB,10/23/91,EDD - Xref,Groups,Pointers In
|
|---|
| 2 | ;;4.0;XB;;Jul 20, 2009;Build 2
|
|---|
| 3 | ;; David Bolduc - Togus, ME
|
|---|
| 4 | XREF ;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
|
|---|
| 9 | XREFPRT ;
|
|---|
| 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
|
|---|
| 15 | PT ;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
|
|---|
| 20 | PTNO ;
|
|---|
| 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
|
|---|
| 26 | PTYES ;
|
|---|
| 27 | S GL=^DIC(ZFILE,0,"GL"),ZFILEN=$P(^DIC(ZFILE,0),U) Q
|
|---|
| 28 | PTPRT ;
|
|---|
| 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
|
|---|
| 34 | GRP ;Groups
|
|---|
| 35 | S ZMULT="",HD="HD2" D GRPBLD G:FLAGG EX D INIT^XBHEDD7 G:FLAGQ EX D HD2,GRPPRT
|
|---|
| 36 | G EX
|
|---|
| 37 | GRPBLD ;
|
|---|
| 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
|
|---|
| 42 | GRPPRT ;
|
|---|
| 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
|
|---|
| 45 | GRPPRT1 ;
|
|---|
| 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
|
|---|
| 49 | EX ;
|
|---|
| 50 | K FLAGPT,GL,GLTEMP,GRP,GRP1,GRP2,HD,NM,ZDD,ZFILE,ZFILEN,ZFILETP,ZFLD,ZGL1,ZMULT
|
|---|
| 51 | K ^UTILITY($J,"GROUP") Q
|
|---|
| 52 | HD1 ;XREF
|
|---|
| 53 | W !?9,"XREF",?25,"DD",?34,"FLD NUM",?56,"FIELD NAME",!?4,"---------------",?22,"--------",?33,"----------",?46,"------------------------------"
|
|---|
| 54 | Q
|
|---|
| 55 | HD2 ;Groups
|
|---|
| 56 | W !?5,"GROUP NAME",?20,"DD",?27,"FLD NUM",?48,"FIELD NAME",!?5,"-----------",?18,"------",?27,"--------",?39,"------------------------------",!
|
|---|
| 57 | Q
|
|---|
| 58 | HD3 ;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
|
|---|
| 61 | PAGE ;
|
|---|
| 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
|
|---|
