Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DIDGFTPT

DIDGFTPT.m

Go to the documentation of this file.
  1. DIDGFTPT ;GFT/GFT - GET ALL ENTRIES THAT POINT TO ENTRY GFTIEN IN FILE GFTFILE ;20 Aug 2015 4:46 PM
  1. ;;22.2;VA FileMan;**19**;Jan 05, 2016;Build 2
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
  1. ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
  1. ;;Licensed under the terms of the Apache License, Version 2.0.
  1. ;
  1. W !!,"THIS UTILITY TRIES TO FIND ALL ENTRIES IN ALL FILES POINTING TO A CERTAIN FILE",!
  1. D DT^DICRW
  1. N DIC,DIR,X,Y,GFTIEN,GFTANY,GFTFILE,GFTALL,DIRUT,DIBT,GFTIENLIST
  1. K ^TMP($J)
  1. S DIC=1,DIC(0)="AEQM" D ^DIC Q:Y<0 S GFTFILE=+Y,GFTANY=$P(^DIC(GFTFILE,0),U)
  1. S DIR(0)="S^1:One particular "_GFTANY_" Entry;2:All "_GFTANY_" Entries;3:Non-existent "_GFTANY_" Entries"
  1. 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)=""
  1. I $O(DIBT(0)) S DIR(0)=DIR(0)_";4:Entries from a "_GFTANY_" Search Template"
  1. S DIR("A")="Find pointers to"
  1. S DIR("B")=$P($P(DIR(0),";",2),":",2)
  1. D ^DIR K DIR Q:$G(DIRUT)
  1. I Y=4 S DIC=.401,DIC("S")="I $D(DIBT(+Y))",GFTANY=Y D ^DIC Q:Y'>0 K DIBT,DIC M GFTIENLIST=^DIBT(+Y,1) G ZIS
  1. S DIC=GFTFILE,DIC("A")="Find pointers to "_GFTANY_" Entry: ",GFTANY=Y,GFTIENLIST=0
  1. I Y=1 D ^DIC Q:Y<0 S GFTIENLIST=+Y
  1. ZIS D ^%ZIS Q:$G(POP) U IO
  1. W ! S $Y=0
  1. START K DIC
  1. D DEPEND(GFTFILE,.GFTIENLIST,,"M"_GFTANY)
  1. ;NOW WE HAVE ALL INFO
  1. S GFTIEN="" F S GFTIEN=$O(^TMP($J,GFTFILE,GFTIEN)) Q:GFTIEN="" D Q:'$D(GFTIEN)
  1. .S X=$$GET1^DIQ(GFTFILE,GFTIEN,.01) I X]"" Q:GFTANY=3
  1. .E S X="NON-EXISTENT ENTRY # "_GFTIEN
  1. .W !!,"***",$P(^DIC(GFTFILE,0),U),": " W X,"***"
  1. .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)
  1. ..S Y=$O(^(J,""))
  1. ..W !?9,"`",J,?22,$$GET1^DIQ(I,J,.01)
  1. ..F Q:Y="" W:$X>(IOM-30) ! W ?IOM-30,$P(@("^DD("_Y_",0)"),U) S Y=$O(^TMP($J,GFTFILE,GFTIEN,I,J,Y))
  1. ..I $E($G(IOST))="C",$G(IOSL,24)-3<$Y S DIR(0)="E" D ^DIR S $Y=0 I 'Y K GFTIEN
  1. K ^TMP($J)
  1. I '$G(GFTALL) W !!! D ^%ZISC
  1. Q
  1. ;
  1. ;
  1. DEPEND(GFTFILE,IEN,GFTWHERE,GFTPARAM) ;
  1. I $G(GFTPARAM)["M" N GFTANY S GFTANY=+$P(GFTPARAM,"M",2)
  1. S:$G(GFTWHERE)="" GFTWHERE=$NA(^TMP($J))
  1. K @GFTWHERE ;output array
  1. I $D(IEN)<9 S GFTIEN(GFTFILE,+IEN)="" ;IEN can be either a scalar...
  1. E M GFTIEN(GFTFILE)=IEN ;...or an array
  1. N A,B
  1. S A=0 F S A=+$O(^DD(GFTFILE,0,"PT",A)) Q:'A D
  1. .S B=0 F S B=+$O(^DD(GFTFILE,0,"PT",A,B)) Q:'B D
  1. ..D CHASE(A,B,.GFTRCR)
  1. COMPUTED S A=0 F S A=+$O(^DD(GFTFILE,0,"PTC",A)) Q:'A D
  1. .S B=0 F S B=+$O(^DD(GFTFILE,0,"PTC",A,B)) Q:'B D
  1. ..D CHASE(A,B,.GFTRCR)
  1. Q
  1. ;
  1. ;
  1. CHASE(FILE,FIELD,GFTRCR) ;BUILD AN 'XEC' THAT WILL GO THRU FILE REMEMBERING FIELD'S POINTERS
  1. I FILE=.6!(FILE=1.1) Q ;NOT AUDIT FILES
  1. N GFTF,X,I,J,V,XEC,A,B,D0,D1,D2,D3,D4,D5,D6,D7,D8,D9,DICMX,DIDGFTPT,GFTFISCR
  1. S GFTF=FILE,L=0,PUT="",DIDGFTPT=1 ;want this defined for special FILE SCREENS
  1. UP 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,";")
  1. Q:'$D(^DIC(GFTF,0,"GL")) S J=^("GL"),I=""
  1. I $G(^DD(GFTF,0,"SCR"))]"" S GFTFISCR=^("SCR")
  1. F A=L:-1:0 S X="D"_(L-A),PUT=PUT_"_D"_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)_""","
  1. D Q:'$D(XEC) ;NOW WE HAVE 'L' AS LEVEL AND 'I' AS 'L' FOR LOOPS
  1. .S X=$P($G(^DD(FILE,FIELD,0)),U,4) Q:X="" S A=$P(^(0),U,2),FIELD=FILE_","_FIELD,V=$P(X,";",2)
  1. .I 'V Q:A'["C" Q:A'["p" S DICMX=$P(^(0),U,5,99),XEC="X DICMX I X" I A["m" D Q
  1. ..S XEC=I_"S DIDGFTPT=D0 "_DICMX,DICMX="D PUT^DIDGFTPT(+$G(D),DIDGFTPT,"""_FIELD_""")" ;m=MULTIPLE COMPUTED POINTER
  1. .I V S XEC="S X=$P($G(^("""_$P(X,";")_""")),""^"","_+V_") I X" D:A["V"
  1. ..S XEC=XEC_",$P(X,"";"",2)="""_$$CONVQQ^DILIBF($P(^DIC(GFTFILE,0,"GL"),U,2))_""""
  1. .S XEC=I_XEC_" D PUT(+X,D0,"""_FIELD_""")"
  1. XEC X XEC
  1. Q
  1. ;
  1. PUT(XVAL,Y,FIELD) I '$D(GFTIEN(GFTFILE,XVAL)) Q:$G(GFTANY)<2!($G(GFTANY)=4) ;ONLY WANT POINTERS TO CERTAIN ENTRIES
  1. I $D(GFTFISCR) X GFTFISCR E Q ;FILE SCREEN!
  1. N IENS,L,S S IENS=D0_"," F L=1:1 S S=$G(@("D"_L)) Q:S="" S IENS=S_","_$G(IENS)
  1. S @GFTWHERE@(GFTFILE,XVAL,GFTF,Y,FIELD,IENS)=""
  1. Q
  1. ;
  1. ;
  1. ALL ;Do all files (SO)
  1. D ^%ZIS U IO
  1. N GFTFILE
  1. S GFTFILE=1.99999
  1. F S GFTFILE=$O(^DIC(GFTFILE)) Q:'GFTFILE D
  1. . I GFTFILE=80.2 Q
  1. . I GFTFILE=80.3 Q
  1. . N GFTIEN,GFTANY,GFTALL
  1. . S GFTIEN=0,GFTANY=3,GFTALL=1
  1. . D START
  1. .Q
  1. ;
  1. D ^%ZISC
  1. Q