DIKCUTL2 ;SFISC/MKO-UTILITY OPTION TO MODIFY INDEX ;17DEC2010
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
;========
; $$TYPE
;========
;Prompt for type xref (to reindex or modify)
;Returns:
; '1' for Traditional; or
; '2' for New
;
TYPE() ;
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="SAM^1:TRADITIONAL;2:NEW"
S DIR("A")="What type of cross-reference (Traditional or New)? "
S DIR("B")="Traditional"
S DIR("?",1)="Enter 'T' to select a Traditional cross-reference."
S DIR("?",2)=" Traditional cross references are stored in the data"
S DIR("?",3)=" dictionary under ^DD(file#,field#,1)."
S DIR("?",4)=" "
S DIR("?",5)="Enter 'N' to select a New-Style cross-reference."
S DIR("?",6)=" New-Style cross references are stored in the Index file."
S DIR("?",7)=" Compound indexes (indexes based on more than one field)"
S DIR("?")=" are examples of New-Style cross-references."
D ^DIR
Q $S($D(DIRUT):"",1:Y)
;
;==========================
; GETXR(file#,.count,flag)
;==========================
;Loop through the "AC" index to get the list of Index file
;xrefs with root file FIL.
;In:
; FIL = Root file #
; FLG [ "M" : also get xrefs on subfiles of FIL
;Out:
; CNT = # xrefs^rootFile# (or null if FLG [ "M")
; CNT(xref#) = rootFile#^File#^xrefName^rootType^UI[if uniq index]
;
GETXR(FIL,CNT,FLG) ;
N F,SB,XR
K CNT
D:$G(FLG)["M" SUBFILES^DIKCU(FIL,.SB)
S SB(FIL)=""
;
S (CNT,F)=0 F S F=$O(SB(F)) Q:'F D
. S XR=0 F S XR=$O(^DD("IX","AC",F,XR)) Q:'XR D
.. I $G(^DD("IX",XR,0))?."^" K ^DD("IX","AC",F,XR) Q
..I $G(FLG)["x",$G(^("NOREINDEX")) Q ;167
.. S CNT=CNT+1
.. S CNT(XR)=F_U_$P($G(^DD("IX",XR,0)),U,1,2)_U_$P(^(0),U,8)
.. S:$D(^DD("KEY","AU",XR)) $P(CNT(XR),U,5)="UI"
;
S:$G(FLG)'["M" $P(CNT,U,2)=FIL
Q
;
;============================
; LIST(.count,header,screen)
;============================
;List the xrefs in the CNT array
;In:
; CNT = Array of xrefs to print (obtained by GETXR call above)
; HDR = Text to print before listing
; (default is 'Current Indexes[ on [sub]file #xxx]:')
; SCR = Sets $T to screen out indexes (Y = index#)
;
LIST(CNT,HDR,SCR) ;
I '$G(CNT) W:$P(CNT,U,2) !,"There are no INDEX file cross-references defined on "_$$FSTR($P(CNT,U,2))_"." Q
N FIL,I,ONEFIL,RFIL,TYP,TXT,UI,XR,Y
;
S ONEFIL=$P(CNT,U,2)
S:$G(HDR)="" HDR="Current Indexes"_$S(ONEFIL:" on "_$$FSTR(ONEFIL),1:"")_":"
W !,HDR
;
S XR=0 F S XR=$O(CNT(XR)) Q:'XR D
. I $G(SCR)]"" K Y S Y=XR,Y(0)=CNT(XR) X SCR K Y E Q
. S FIL=$P(CNT(XR),U,2),RFIL=$P(CNT(XR),U),TYP=$P(CNT(XR),U,4)
. S UI=$S($P(CNT(XR),U,5)="UI":"uniqueness ",1:"")
. S RFIL=$S('ONEFIL:" on "_$$FSTR(RFIL),1:"")
. ;
. S TXT=XR_" "_$J("",5-$L(XR))_"'"_$P(CNT(XR),U,3)_"' "_UI
. I TYP'="W" S TXT=TXT_"index"_RFIL
. E S TXT=TXT_"whole file index"_RFIL_" (resides on "_$$FSTR(FIL)_")"
. ;
. D WRAP^DIKCU2(.TXT,-11,-2)
. W !," "_TXT F I=1:1 Q:$D(TXT(I))[0 W !?10,TXT(I)
. K TXT
Q
;
;================================
; $$CHOOSE(.count,prompt,screen)
;================================
;Prompt for a xref from the DIKCCNT array
;In:
; DIKCCNT = Array contain xref data (obtained by GETXR call above)
; DIKCPR = Action to include with the prompt
; DIKCSCR = Sets $T to screen out entries (Y=index#)
;Returns:
; Index ien (or 0, if none selected)
;
CHOOSE(DIKCCNT,DIKCPR,DIKCSCR) ;
Q:'$G(DIKCCNT) 0
N I,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
;
S DIR(0)="SAO^"
S I=0 F S I=$O(DIKCCNT(I)) Q:'I S DIR("C",I)=I_":"_$P(DIKCCNT(I),U,3)
S DIR("A")="Which Index do you wish to "_DIKCPR_"? "
S:+DIKCCNT=1 DIR("B")=$O(DIKCCNT(0))
S DIR("?")="",DIR("??")="^D LIST^DIKCUTL2(.DIKCCNT)"
W ! D ^DIR I 'Y!$D(DIRUT) Q 0
Q Y
;
;====================
; $$FSTR(file#,flag)
;====================
;Return string 'file #xxx' or 'subfile #xxx'
;In:
; FIL = File #
; FLG [ U : Capitalize 'File' or 'Subfile'
;
FSTR(FIL,FLG) ;
;Q $P($P("f;F^subf;Subf",U,$G(^DD(FIL,0,"UP"))>0+1),";",$G(FLG)["U"+1)_"ile #"_FIL
Q $P($$EZBLD^DIALOG(8098),U,$G(^DD(FIL,0,"UP"))>0*2+1+($G(FLG)["U"))_" #"_FIL
;
;================
; PRTMSG(index#)
;================
;Print message that DIXR can't be deleted because it's the
;Uniqueness Index for a key.
;In:
; DIXR = index #
;
PRTMSG(DIXR) ;
N KEYID,I,INDID,MSG
;
S KEYID=$O(^DD("KEY","AU",DIXR,0)) Q:'KEYID
S KEYID=$G(^DD("KEY",KEYID,0)) Q:KEYID?."^"
S KEYID="Key '"_$P(KEYID,U,2)_"' on File #"_$P(KEYID,U)
;
S INDID="Index '"_$P($G(^DD("IX",DIXR,0)),U,2)_"'"
S MSG(0)=INDID_" cannot be deleted. It is the uniqueness index for "_KEYID_"."
D WRAP^DIKCU2(.MSG)
;
W $C(7) F I=0:1 Q:'$D(MSG(I)) W !,MSG(I)
Q
;
;================
; BLDLOG(index#)
;================
;Build and file the logic of the cross reference.
;In:
; DIXR = index #
;
;Called from EDIT^DIKCUTL after an Index is edited.
;The reason for this call is if the user deletes some Cross-Reference
;Values, and then Quits the form, the Set/Kill logic may not reflect
;the deleted Values.
;
BLDLOG(DIXR) ;
N CNT,CRV,CRV0,DIERR,FCNT,FDA,FILE,IX0,KILL,L,LDIF,MAXL,MSG
N NAME,ORD,ROOT,RTYPE,RFILE,SBSC,SET,VAL,WKILL
;
;Get index data
S IX0=$G(^DD("IX",DIXR,0)) Q:IX0?."^"
I $P(IX0,U,4)="MU" D UPDEXEC(DIXR) Q
S FILE=$P(IX0,U),NAME=$P(IX0,U,2),RTYPE=$P(IX0,U,8),RFILE=$P(IX0,U,9)
;
;Build root of index and the 'Kill Entire Index Code'
I FILE'=RFILE Q:RTYPE'="W" S LDIF=$$FLEVDIFF^DIKCU(FILE,RFILE)
E S LDIF=0
S ROOT=$$FROOTDA^DIKCU(FILE,LDIF_"O")_""""_NAME_""""
S WKILL="K "_ROOT_")"
;
;Loop through Cross-Reference Values multiple
;Build SBSC(subscript#)=order#^maxLength array
S CRV=0 F S CRV=$O(^DD("IX",DIXR,11.1,CRV)) Q:'CRV D
. S CRV0=$G(^DD("IX",DIXR,11.1,CRV,0)) Q:CRV0?."^"
. S ORD=$P(CRV0,U) Q:'ORD
. S:$P(CRV0,U,2)="F" FCNT=$G(FCNT)+1
. S CNT=$G(CNT)+1
. S SBSC=$P(CRV0,U,6) Q:'SBSC
. S MAXL=$P(CRV0,U,5)
. S SBSC(SBSC)=ORD_U_MAXL
;
;Loop through SBSC array and build the root w/ X(n) array
S SBSC=0 F S SBSC=$O(SBSC(SBSC)) Q:'SBSC D
. S ORD=$P(SBSC(SBSC),U),MAXL=$P(SBSC(SBSC),U,2)
. I $G(CNT)=1 S VAL=$S(MAXL:"$E(X,1,"_MAXL_")",1:"X")
. E S VAL=$S(MAXL:"$E(X("_ORD_"),1,"_MAXL_")",1:"X("_ORD_")")
. S ROOT=ROOT_","_VAL
;
;Append DA(n) to root
F L=LDIF:-1:1 S ROOT=ROOT_",DA("_L_")"
S ROOT=ROOT_",DA)"
;
;Build and file the Set and Kill Logic and the Execution
I '$O(SBSC(0)) S (SET,KILL)="Q",WKILL=""
E S SET="S "_ROOT_"=""""",KILL="K "_ROOT
K FDA
S FDA(.11,DIXR_",",1.1)=SET
S FDA(.11,DIXR_",",2.1)=KILL
S FDA(.11,DIXR_",",2.5)=WKILL
S FDA(.11,DIXR_",",.4)=$S($G(FCNT)>1:"R",1:"F")
D FILE^DIE("","FDA","MSG")
Q
;
UPDEXEC(DIXR) ;Update Execution based on number of field-type xref values
N CRV,CRV0,DIERR,FCNT,FDA,MSG
S CRV(1)=DIXR,CRV=0
F S CRV=$O(^DD("IX",DIXR,11.1,CRV)) Q:'CRV D
. S CRV0=$G(^DD("IX",DIXR,11.1,CRV,0)) Q:'CRV0
. S:$P(CRV0,U,2)="F" FCNT=$G(FCNT)+1
S FDA(.11,DIXR_",",.4)=$S($G(FCNT)>1:"R",1:"F")
D FILE^DIE("","FDA","MSG")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIKCUTL2 7361 printed Sep 23, 2025@20:25:01 Page 2
DIKCUTL2 ;SFISC/MKO-UTILITY OPTION TO MODIFY INDEX ;17DEC2010
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
+7 ;========
+8 ; $$TYPE
+9 ;========
+10 ;Prompt for type xref (to reindex or modify)
+11 ;Returns:
+12 ; '1' for Traditional; or
+13 ; '2' for New
+14 ;
TYPE() ;
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 SET DIR(0)="SAM^1:TRADITIONAL;2:NEW"
+3 SET DIR("A")="What type of cross-reference (Traditional or New)? "
+4 SET DIR("B")="Traditional"
+5 SET DIR("?",1)="Enter 'T' to select a Traditional cross-reference."
+6 SET DIR("?",2)=" Traditional cross references are stored in the data"
+7 SET DIR("?",3)=" dictionary under ^DD(file#,field#,1)."
+8 SET DIR("?",4)=" "
+9 SET DIR("?",5)="Enter 'N' to select a New-Style cross-reference."
+10 SET DIR("?",6)=" New-Style cross references are stored in the Index file."
+11 SET DIR("?",7)=" Compound indexes (indexes based on more than one field)"
+12 SET DIR("?")=" are examples of New-Style cross-references."
+13 DO ^DIR
+14 QUIT $SELECT($DATA(DIRUT):"",1:Y)
+15 ;
+16 ;==========================
+17 ; GETXR(file#,.count,flag)
+18 ;==========================
+19 ;Loop through the "AC" index to get the list of Index file
+20 ;xrefs with root file FIL.
+21 ;In:
+22 ; FIL = Root file #
+23 ; FLG [ "M" : also get xrefs on subfiles of FIL
+24 ;Out:
+25 ; CNT = # xrefs^rootFile# (or null if FLG [ "M")
+26 ; CNT(xref#) = rootFile#^File#^xrefName^rootType^UI[if uniq index]
+27 ;
GETXR(FIL,CNT,FLG) ;
+1 NEW F,SB,XR
+2 KILL CNT
+3 if $GET(FLG)["M"
DO SUBFILES^DIKCU(FIL,.SB)
+4 SET SB(FIL)=""
+5 ;
+6 SET (CNT,F)=0
FOR
SET F=$ORDER(SB(F))
if 'F
QUIT
Begin DoDot:1
+7 SET XR=0
FOR
SET XR=$ORDER(^DD("IX","AC",F,XR))
if 'XR
QUIT
Begin DoDot:2
+8 IF $GET(^DD("IX",XR,0))?."^"
KILL ^DD("IX","AC",F,XR)
QUIT
+9 ;167
IF $GET(FLG)["x"
IF $GET(^("NOREINDEX"))
QUIT
+10 SET CNT=CNT+1
+11 SET CNT(XR)=F_U_$PIECE($GET(^DD("IX",XR,0)),U,1,2)_U_$PIECE(^(0),U,8)
+12 if $DATA(^DD("KEY","AU",XR))
SET $PIECE(CNT(XR),U,5)="UI"
End DoDot:2
End DoDot:1
+13 ;
+14 if $GET(FLG)'["M"
SET $PIECE(CNT,U,2)=FIL
+15 QUIT
+16 ;
+17 ;============================
+18 ; LIST(.count,header,screen)
+19 ;============================
+20 ;List the xrefs in the CNT array
+21 ;In:
+22 ; CNT = Array of xrefs to print (obtained by GETXR call above)
+23 ; HDR = Text to print before listing
+24 ; (default is 'Current Indexes[ on [sub]file #xxx]:')
+25 ; SCR = Sets $T to screen out indexes (Y = index#)
+26 ;
LIST(CNT,HDR,SCR) ;
+1 IF '$GET(CNT)
if $PIECE(CNT,U,2)
WRITE !,"There are no INDEX file cross-references defined on "_$$FSTR($PIECE(CNT,U,2))_"."
QUIT
+2 NEW FIL,I,ONEFIL,RFIL,TYP,TXT,UI,XR,Y
+3 ;
+4 SET ONEFIL=$PIECE(CNT,U,2)
+5 if $GET(HDR)=""
SET HDR="Current Indexes"_$SELECT(ONEFIL:" on "_$$FSTR(ONEFIL),1:"")_":"
+6 WRITE !,HDR
+7 ;
+8 SET XR=0
FOR
SET XR=$ORDER(CNT(XR))
if 'XR
QUIT
Begin DoDot:1
+9 IF $GET(SCR)]""
KILL Y
SET Y=XR
SET Y(0)=CNT(XR)
XECUTE SCR
KILL Y
IF '$TEST
QUIT
+10 SET FIL=$PIECE(CNT(XR),U,2)
SET RFIL=$PIECE(CNT(XR),U)
SET TYP=$PIECE(CNT(XR),U,4)
+11 SET UI=$SELECT($PIECE(CNT(XR),U,5)="UI":"uniqueness ",1:"")
+12 SET RFIL=$SELECT('ONEFIL:" on "_$$FSTR(RFIL),1:"")
+13 ;
+14 SET TXT=XR_" "_$JUSTIFY("",5-$LENGTH(XR))_"'"_$PIECE(CNT(XR),U,3)_"' "_UI
+15 IF TYP'="W"
SET TXT=TXT_"index"_RFIL
+16 IF '$TEST
SET TXT=TXT_"whole file index"_RFIL_" (resides on "_$$FSTR(FIL)_")"
+17 ;
+18 DO WRAP^DIKCU2(.TXT,-11,-2)
+19 WRITE !," "_TXT
FOR I=1:1
if $DATA(TXT(I))[0
QUIT
WRITE !?10,TXT(I)
+20 KILL TXT
End DoDot:1
+21 QUIT
+22 ;
+23 ;================================
+24 ; $$CHOOSE(.count,prompt,screen)
+25 ;================================
+26 ;Prompt for a xref from the DIKCCNT array
+27 ;In:
+28 ; DIKCCNT = Array contain xref data (obtained by GETXR call above)
+29 ; DIKCPR = Action to include with the prompt
+30 ; DIKCSCR = Sets $T to screen out entries (Y=index#)
+31 ;Returns:
+32 ; Index ien (or 0, if none selected)
+33 ;
CHOOSE(DIKCCNT,DIKCPR,DIKCSCR) ;
+1 if '$GET(DIKCCNT)
QUIT 0
+2 NEW I,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+3 ;
+4 SET DIR(0)="SAO^"
+5 SET I=0
FOR
SET I=$ORDER(DIKCCNT(I))
if 'I
QUIT
SET DIR("C",I)=I_":"_$PIECE(DIKCCNT(I),U,3)
+6 SET DIR("A")="Which Index do you wish to "_DIKCPR_"? "
+7 if +DIKCCNT=1
SET DIR("B")=$ORDER(DIKCCNT(0))
+8 SET DIR("?")=""
SET DIR("??")="^D LIST^DIKCUTL2(.DIKCCNT)"
+9 WRITE !
DO ^DIR
IF 'Y!$DATA(DIRUT)
QUIT 0
+10 QUIT Y
+11 ;
+12 ;====================
+13 ; $$FSTR(file#,flag)
+14 ;====================
+15 ;Return string 'file #xxx' or 'subfile #xxx'
+16 ;In:
+17 ; FIL = File #
+18 ; FLG [ U : Capitalize 'File' or 'Subfile'
+19 ;
FSTR(FIL,FLG) ;
+1 ;Q $P($P("f;F^subf;Subf",U,$G(^DD(FIL,0,"UP"))>0+1),";",$G(FLG)["U"+1)_"ile #"_FIL
+2 QUIT $PIECE($$EZBLD^DIALOG(8098),U,$GET(^DD(FIL,0,"UP"))>0*2+1+($GET(FLG)["U"))_" #"_FIL
+3 ;
+4 ;================
+5 ; PRTMSG(index#)
+6 ;================
+7 ;Print message that DIXR can't be deleted because it's the
+8 ;Uniqueness Index for a key.
+9 ;In:
+10 ; DIXR = index #
+11 ;
PRTMSG(DIXR) ;
+1 NEW KEYID,I,INDID,MSG
+2 ;
+3 SET KEYID=$ORDER(^DD("KEY","AU",DIXR,0))
if 'KEYID
QUIT
+4 SET KEYID=$GET(^DD("KEY",KEYID,0))
if KEYID?."^"
QUIT
+5 SET KEYID="Key '"_$PIECE(KEYID,U,2)_"' on File #"_$PIECE(KEYID,U)
+6 ;
+7 SET INDID="Index '"_$PIECE($GET(^DD("IX",DIXR,0)),U,2)_"'"
+8 SET MSG(0)=INDID_" cannot be deleted. It is the uniqueness index for "_KEYID_"."
+9 DO WRAP^DIKCU2(.MSG)
+10 ;
+11 WRITE $CHAR(7)
FOR I=0:1
if '$DATA(MSG(I))
QUIT
WRITE !,MSG(I)
+12 QUIT
+13 ;
+14 ;================
+15 ; BLDLOG(index#)
+16 ;================
+17 ;Build and file the logic of the cross reference.
+18 ;In:
+19 ; DIXR = index #
+20 ;
+21 ;Called from EDIT^DIKCUTL after an Index is edited.
+22 ;The reason for this call is if the user deletes some Cross-Reference
+23 ;Values, and then Quits the form, the Set/Kill logic may not reflect
+24 ;the deleted Values.
+25 ;
BLDLOG(DIXR) ;
+1 NEW CNT,CRV,CRV0,DIERR,FCNT,FDA,FILE,IX0,KILL,L,LDIF,MAXL,MSG
+2 NEW NAME,ORD,ROOT,RTYPE,RFILE,SBSC,SET,VAL,WKILL
+3 ;
+4 ;Get index data
+5 SET IX0=$GET(^DD("IX",DIXR,0))
if IX0?."^"
QUIT
+6 IF $PIECE(IX0,U,4)="MU"
DO UPDEXEC(DIXR)
QUIT
+7 SET FILE=$PIECE(IX0,U)
SET NAME=$PIECE(IX0,U,2)
SET RTYPE=$PIECE(IX0,U,8)
SET RFILE=$PIECE(IX0,U,9)
+8 ;
+9 ;Build root of index and the 'Kill Entire Index Code'
+10 IF FILE'=RFILE
if RTYPE'="W"
QUIT
SET LDIF=$$FLEVDIFF^DIKCU(FILE,RFILE)
+11 IF '$TEST
SET LDIF=0
+12 SET ROOT=$$FROOTDA^DIKCU(FILE,LDIF_"O")_""""_NAME_""""
+13 SET WKILL="K "_ROOT_")"
+14 ;
+15 ;Loop through Cross-Reference Values multiple
+16 ;Build SBSC(subscript#)=order#^maxLength array
+17 SET CRV=0
FOR
SET CRV=$ORDER(^DD("IX",DIXR,11.1,CRV))
if 'CRV
QUIT
Begin DoDot:1
+18 SET CRV0=$GET(^DD("IX",DIXR,11.1,CRV,0))
if CRV0?."^"
QUIT
+19 SET ORD=$PIECE(CRV0,U)
if 'ORD
QUIT
+20 if $PIECE(CRV0,U,2)="F"
SET FCNT=$GET(FCNT)+1
+21 SET CNT=$GET(CNT)+1
+22 SET SBSC=$PIECE(CRV0,U,6)
if 'SBSC
QUIT
+23 SET MAXL=$PIECE(CRV0,U,5)
+24 SET SBSC(SBSC)=ORD_U_MAXL
End DoDot:1
+25 ;
+26 ;Loop through SBSC array and build the root w/ X(n) array
+27 SET SBSC=0
FOR
SET SBSC=$ORDER(SBSC(SBSC))
if 'SBSC
QUIT
Begin DoDot:1
+28 SET ORD=$PIECE(SBSC(SBSC),U)
SET MAXL=$PIECE(SBSC(SBSC),U,2)
+29 IF $GET(CNT)=1
SET VAL=$SELECT(MAXL:"$E(X,1,"_MAXL_")",1:"X")
+30 IF '$TEST
SET VAL=$SELECT(MAXL:"$E(X("_ORD_"),1,"_MAXL_")",1:"X("_ORD_")")
+31 SET ROOT=ROOT_","_VAL
End DoDot:1
+32 ;
+33 ;Append DA(n) to root
+34 FOR L=LDIF:-1:1
SET ROOT=ROOT_",DA("_L_")"
+35 SET ROOT=ROOT_",DA)"
+36 ;
+37 ;Build and file the Set and Kill Logic and the Execution
+38 IF '$ORDER(SBSC(0))
SET (SET,KILL)="Q"
SET WKILL=""
+39 IF '$TEST
SET SET="S "_ROOT_"="""""
SET KILL="K "_ROOT
+40 KILL FDA
+41 SET FDA(.11,DIXR_",",1.1)=SET
+42 SET FDA(.11,DIXR_",",2.1)=KILL
+43 SET FDA(.11,DIXR_",",2.5)=WKILL
+44 SET FDA(.11,DIXR_",",.4)=$SELECT($GET(FCNT)>1:"R",1:"F")
+45 DO FILE^DIE("","FDA","MSG")
+46 QUIT
+47 ;
UPDEXEC(DIXR) ;Update Execution based on number of field-type xref values
+1 NEW CRV,CRV0,DIERR,FCNT,FDA,MSG
+2 SET CRV(1)=DIXR
SET CRV=0
+3 FOR
SET CRV=$ORDER(^DD("IX",DIXR,11.1,CRV))
if 'CRV
QUIT
Begin DoDot:1
+4 SET CRV0=$GET(^DD("IX",DIXR,11.1,CRV,0))
if 'CRV0
QUIT
+5 if $PIECE(CRV0,U,2)="F"
SET FCNT=$GET(FCNT)+1
End DoDot:1
+6 SET FDA(.11,DIXR_",",.4)=$SELECT($GET(FCNT)>1:"R",1:"F")
+7 DO FILE^DIE("","FDA","MSG")
+8 QUIT
