DICF4 ;SEA/TOAD,SF/TKW-VA FileMan: Finder, (pointer indexes) ;2/16/00  13:31
 ;;22.0;VA FileMan;**4,31**;Mar 30, 1999
 ;Per VHA Directive 10-93-142, this routine should not be modified.
 ;
POINT(DIFILE,DIFLAGS,DINDEX,DIDENT,DIEN,DIFIEN,DISCREEN,DIVALUE,DIC,DIFORCE) ;
 ; PREPIX^DICF2--transform value for indexed pointer field
 N DIF,DIFL,DIX,DIPVAL,DISCR,DITARGET,DISKIP,DIPRV,DINEW
 S DIF=$TR(DIFLAGS,$TR(DIFLAGS,"4XOB"))_"Mp",DIX="B"
 I DIFLAGS["B" S DIF=$TR(DIF,"M")
 D GETTMP^DICUIX1(.DITARGET,"DICF")
 S DITARGET("C")=0
 S (DIPRV,DINEW)="S" F  S DINEW=$O(DISCREEN(DINEW)) Q:$E(DINEW)'="S"  S DIPRV=DINEW,DISCR(DIPRV)=DISCREEN(DIPRV)
 S DINEW="S"_($P(DIPRV,"S",2)+1)
P1 ; Process regular pointer
 I DINDEX(1,"TYPE")="P" D  Q
 . S DIFL=+$P($P(DINDEX(1,"NODE"),U,2),"P",2) Q:'DIFL
 . M DIPVAL(1)=DIVALUE(1),DISCR(1)=DISCREEN(1)
 . I DIFLAGS["l" D DIC(.DIC,.DIEN,.DIFILE,.DINDEX,.DIVALUE,DITARGET)
 . I DIFLAGS'["l" D
 . . I $D(DIFORCE("PTRIX")) D SETIX(.DIFORCE,.DINDEX,.DIX,.DIF)
 . . N F S F=DIF N DIF S DIF=F K F M DIFL("CHAIN")=DIFILE("CHAIN")
 . . D BLDSCR(.DISCR,DINEW,DIPRV,.DIFL,.DINDEX,.DISCREEN,.DIFILE)
 . . D FIND^DICF(.DIFL,",","",DIF,.DIPVAL,"",.DIX,.DISCR,"",.DITARGET)
 . I $G(DIERR)!('$G(@DITARGET)) K @DITARGET Q
 . S DINDEX(1,"IXROOT")=DINDEX(1,"ROOT"),DINDEX(1,"ROOT")=$NA(@DITARGET@("B"))
 . Q
P2 ; Process variable pointer
 I DIFLAGS["l" D  Q
 . D DIC(.DIC,.DIEN,.DIFILE,.DINDEX,.DIVALUE,DITARGET)
 . I $G(DIERR)!('$G(@DITARGET)) K @DITARGET Q
 . S DINDEX(1,"IXROOT")=DINDEX(1,"ROOT"),DINDEX(1,"ROOT")=$NA(@DITARGET@("B"))
 . Q
 N DIFILES I DIVALUE(1)[".",$P(DIVALUE(1),".")]"" D
 . N V S V=$$OUT^DIALOGU($P(DIVALUE(1),"."),"UC")
 . D VPFILES^DIEV1(DINDEX(1,"FILE"),DINDEX(1,"FIELD"),V,.DIFILES)
 . Q
P21 D P3 I $G(DIERR) K @DITARGET Q
 I $O(DIFILES(0)),'$G(@DITARGET) K DIFILES D P3
 I $G(DIERR)!('$G(@DITARGET)) K @DITARGET Q
 S DINDEX(1,"IXROOT")=DINDEX(1,"ROOT"),DINDEX(1,"ROOT")=$NA(@DITARGET@("B"))
 Q
 ;
P3 N DIVP,G,I,X,DIF1,DIS1
 F DIVP=0:0 S DIVP=$O(^DD(DINDEX(1,"FILE"),DINDEX(1,"FIELD"),"V",DIVP)) Q:'DIVP  S X=$G(^(DIVP,0)) D  Q:$G(DIERR)
 . K DIF1,DIFL,DIPVAL,DIS1,DIX S DIX="B"
 . Q:'X  I $O(DIFILES(0)) Q:'$D(DIFILES(+X))
 . I $G(DISCREEN("V",1))]"" D  Q:G=""
 . . S G=$G(^DIC(+X,0,"GL")) Q:G=""
 . . S:'$D(DINDEX(DISUB,"VP",G)) G="" Q
 . S DIF1=DIF_"v",DIFL=+X
 . I $D(DIFORCE("PTRIX")) D SETIX(.DIFORCE,.DINDEX,.DIX,.DIF1)
 . D FILE^DICUF(.DIFL,"",.DIF1) Q:$G(DIERR)
 . M DIS1=DISCR
 . I '$O(DIFILES(0)) M DIPVAL(1)=DIVALUE(1),DIS1(1)=DISCREEN(1)
 . E  D
 . . S DIF1=DIF1_"t"
 . . S DIPVAL(1)=$P(DIVALUE(1),".",2,99)
 . . Q
 . M DIFL("CHAIN")=DIFILE("CHAIN")
 . D BLDSCR(.DIS1,DINEW,DIPRV,.DIFL,.DINDEX,.DISCREEN,.DIFILE)
 . S DITARGET("C")=+$G(@DITARGET)
 . D FIND^DICF(.DIFL,",","",DIF1,.DIPVAL,"",.DIX,.DIS1,"",.DITARGET)
 . Q
 Q
 ;
SETIX(DIFORCE,DINDEX,DIX,DIF) ; If user passes list of indexes to use on pointed-to file, set up to use them.
 M DIX("PTRIX")=DIFORCE("PTRIX") N %
 S %=$G(DIX("PTRIX",DINDEX(1,"FILE"),DINDEX(1,"FIELD"),DIFL))
 Q:%=""  S DIX=%
 I $P(DIX,U,2)="" S:DIF["M" DIF=$TR(DIF,"M") Q
 S:DIF'["M" DIF=DIF_"M" Q
 ;
BLDSCR(DISCR,DINEW,DIPRV,DIFL,DINDEX,DISCREEN,DIFILE) ; Build screen to make sure entry is in pointer index.
 N DICSUBS S DICSUBS=""
 S DISCR(DINEW)=$S(DIPRV="S":" Q",1:" "_DISCREEN("S")_" Q:$T")
 N I S I="I" S:DINDEX(1,"TYPE")["V" I=I_"_"";"_$P(DIFL(DIFL,"O"),U,2)_""""
 S DISCR("S")=DICSUBS_"N "_DINEW_" S "_DINEW_"="_I_" X DISCREEN("""_DINEW_""")"
 I DINDEX("#")>1 D  Q
 . S DISCR(DINEW)="X ""I 0"" I $D("_DIFILE(DIFILE,"O")_""""_DINDEX_""","_DINEW_"))"_DISCR(DINEW)
 . Q
 S DISCR(DINEW)="X ""I 0"" N I F I=0:0 S I=$O("_DIFILE(DIFILE,"O")_""""_DINDEX_""","_DINEW_",I)) Q:'I  I $D("_DIFILE(DIFILE,"O")_"I,0))"_DISCR(DINEW)
 Q
 ;
SETDA(DIEN) ; Return code that sets DA array to current level when pointer field is in a multiple.  DA itself=DA(1).
 N %,DICODE S DICODE="S DA="_+$G(DIEN(1))
 F %=1:1 Q:'$D(DIEN(%))  S DICODE=DICODE_",DA("_%_")="_DIEN(%)
 Q DICODE
 ;
DIC(DIC,DIEN,DIFILE,DINDEX,DIVALUE,DITARGET) ; If we were called from ^DIC, we want to do recursive lookup there.
 N %,%Y,D,DD,DIVAL,DF,DID,DINUM,DICRS,DS,DO,X,Y,DIFINDER
 S DO(2)=DIFILE,(D,DF)=DINDEX("START"),(X,DIVAL(1))=DIVALUE(1),DIVAL(0)=1
 S DD=0,%=DINDEX,DS=$G(^DD(DINDEX(1,"FILE"),DINDEX(1,"FIELD"),0)),Y=DINDEX(1,"TYPE"),%Y=DINDEX(1,"FIELD")
 S:$G(DICR)="" DICR=0
 D
 . N DIFILE,I
 . S DIFINDER="p"
 . M I=DIC N DIC M DIC=I K I
 . N DA X $$SETDA(.DIEN) N DIEN
 . D A^DICM Q:Y=-1  D ^DICM1 K DICR(DICR) S DICR=DICR-1 I DICR<1 K DICR
 . Q
 Q:Y'>0
 S @DITARGET@("B",($P(Y,U,2)_U_X))="",@DITARGET=1
 Q
 ;
ERR(DIERN,DIFILE,DIIENS,DIFIELD,DI1,DI2,DI3) ;
 ; error logging procedure
 N DIPE
 N DI F DI="FILE","IENS","FIELD",1:1:3 S DIPE(DI)=$G(@("DI"_DI))
 D BLD^DIALOG(DIERN,.DIPE,.DIPE)
 Q
 ;