DIDGFTPT ;GET ALL ENTRIES THAT POINT TO ENTRY GFTIEN IN FILE GFTFILE;18JUN2010
 ;
 W !!,"THIS UTILITY TRIES TO FIND ALL ENTRIES IN ALL FILES POINTING TO A CERTAIN FILE",!
 D DT^DICRW
 N DIC,DIR,X,Y,GFTIEN,GFTANY,GFTFILE,GFTALL,DIRUT,DIBT,GFTIENLIST
 K ^TMP($J)
 S DIC=1,DIC(0)="AEQM" D ^DIC Q:Y<1  S GFTFILE=+Y,GFTANY=$P(^DIC(GFTFILE,0),U)
 S DIR(0)="S^1:One particular "_GFTANY_" Entry;2:All "_GFTANY_" Entries;3:Non-existent "_GFTANY_" Entries"
 S X="" F  S X=$O(^DIBT("F"_GFTFILE,X)) Q:X=""  F Y=0:0 S Y=$O(^DIBT("F"_GFTFILE,X,Y)) Q:'Y  I $D(^DIBT(Y,1))>1 S DIBT(Y)=""
 I $O(DIBT(0)) S DIR(0)=DIR(0)_";4:Entries from a "_GFTANY_" Search Template"
 S DIR("A")="Find pointers to"
 S DIR("B")=$P($P(DIR(0),";",2),":",2)
 D ^DIR K DIR Q:$G(DIRUT)
 I Y=4 S DIC=.401,DIC("S")="I $D(DIBT(+Y))" D ^DIC Q:Y'>0  K DIBT,DIC M GFTIENLIST=^DIBT(+Y,1) G ZIS
 S DIC=GFTFILE,DIC("A")="Find pointers to "_GFTANY_" Entry: ",GFTANY=Y,GFTIENLIST=0
 I Y=1 D ^DIC Q:Y<0  S GFTIENLIST=+Y
ZIS D ^%ZIS Q:$G(POP)  U IO
 W ! S $Y=0
START K DIC
 D DEPEND(GFTFILE,.GFTIENLIST)
 S GFTIEN="" F  S GFTIEN=$O(^TMP($J,GFTFILE,GFTIEN)) Q:GFTIEN=""  D  Q:'$D(GFTIEN)
 .S X=$$GET1^DIQ(GFTFILE,GFTIEN,.01) I X]"" Q:GFTANY>2
 .E  S X="NON-EXISTENT ENTRY # "_GFTIEN
 .W !!,"***",$P(^DIC(GFTFILE,0),U),": "  W X,"***"
 .F I=0:0 Q:'$D(GFTIEN)  S I=$O(^TMP($J,GFTFILE,GFTIEN,I)) Q:'I  W !,"FILE ",I," (",$P(^DIC(I,0),U),")" F J=0:0 S J=$O(^TMP($J,GFTFILE,GFTIEN,I,J)) Q:'J  D  Q:'$D(GFTIEN)
 ..S Y=$O(^(J,""))
 ..W !?9,"`",J,?22,$$GET1^DIQ(I,J,.01)
 ..F  Q:Y=""  W:$X>(IOM-30) ! W ?IOM-30,Y S Y=$O(^TMP($J,GFTFILE,GFTIEN,I,J,Y))
 ..I $E($G(IOST))="C",$G(IOSL,24)-3<$Y S DIR(0)="E" D ^DIR S $Y=0 I 'Y K GFTIEN
 K ^TMP($J)
 I '$G(GFTALL) D ^%ZISC
 Q
 ;
 ;
DEPEND(GFTFILE,IEN,GFTWHERE,GFTRCR) ;
 S:$G(GFTWHERE)="" GFTWHERE=$NA(^TMP($J))
    K @GFTWHERE ;output array
 I $D(IEN)<9 S GFTIEN(GFTFILE,+IEN)="" ;IEN can be either a scalar...
 E  M GFTIEN(GFTFILE)=IEN ;...or an array
 N A,B
 S A=0 F  S A=+$O(^DD(GFTFILE,0,"PT",A)) Q:'A  D
 . S B=0 F  S B=+$O(^DD(GFTFILE,0,"PT",A,B)) Q:'B  D
 . . D CHASE(A,B,.GFTRCR)
 Q
         ;
         ;
CHASE(FILE,FIELD,GFTRCR) ;
 N GFTF,X,I,J,V,XEC,A,B
 S GFTF=FILE,L=0
 S X=$P($G(^DD(GFTF,FIELD,0)),U,4),V=$P(X,";",2) Q:'V  S I=$P(^(0),U,2),FIELD=$P(^(0),U)
 S XEC="S X=$P($G(^("""_$P(X,";")_""")),""^"","_+V_") I X" I I["V" S XEC=XEC_",$P(X,"";"",2)="""_$$CONVQQ^DILIBF($P(^DIC(GFTFILE,0,"GL"),U,2))_""""
 S XEC=XEC_" D PUT(+X,"
 F  S I=$G(^DD(GFTF,0,"UP")) Q:'I  S L=L+1,X=$O(^DD(I,"SB",GFTF,0)) Q:'X  S J=$P($G(^DD(I,X,0)),U,4) Q:J'[";0"  S GFTF=I,J(L)=$P(J,";")
 Q:'$D(^DIC(GFTF,0,"GL"))  S J=^("GL"),I=""
 F A=L:-1:0 S X="X"_A,I=I_"F "_X_"=0:0 S "_X_"=$O("_J_X_")) Q:'"_X_"  I $D(^("_X_",0)) " I A S J=J_X_","""_J(A)_""","
 S XEC=I_XEC_"X"_L_","""_FIELD_""")"
 X XEC
 Q
 ;
PUT(XVAL,XFROM,FIELD) I GFTANY>1!$D(GFTIEN(GFTFILE,XVAL)) S @GFTWHERE@(GFTFILE,XVAL,GFTF,XFROM,FIELD)=""
 Q
 ;
 ;
ALL ;Do all files (SO)
 D ^%ZIS U IO
 N GFTFILE
 S GFTFILE=1.99999
 F  S GFTFILE=$O(^DIC(GFTFILE)) Q:'GFTFILE  D
 . I GFTFILE=80.2 Q
 . I GFTFILE=80.3 Q
 . N GFTIEN,GFTANY,GFTALL
 . S GFTIEN=0,GFTANY=3,GFTALL=1
 . D START
 .Q
 ;
 D ^%ZISC
 Q
