DIVC ;SFISC/MKO-VERIFY INDEXES/KEYS ;2:47 PM 23 Jan 1998
;;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.
;
;============================================
; VINDEX(file,record,field,flag,.index,.key)
;============================================
;Programmer entry point to check the existence of indexes and
;key integrity for a single file/field/record. (Currently not used)
;In:
; DIFILE = file or subfile # (required)
; DIREC = DA array or IENS (required)
; DIFLD = field # (required)
; DIFLAG [ D : generate dialog errors
;Out:
; For invalid indexes/keys:
; .DIINDEX(indexName,index#) = "" : if an index is not set
; .DIKEY(file#,keyName,uiNumber) = null : if a key field is null
; uniq : if a key not unique
;
VINDEX(DIFILE,DIREC,DIFLD,DIFLAG,DIINDEX,DIKEY) ;
N DA,DIROOT,DIVCTMP,DIVERR
;
;Initialization
S DIFLAG=$G(DIFLAG),DIVERR=0
I DIFLAG["D",'$D(DIQUIET) N DIQUIET S DIQUIET=1
I DIFLAG["D",'$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
;
;Check and convert input paramaters
D CHK Q:DIVERR
;
;Load xref info
S DIVCTMP=$$GETTMP^DIKC1("DIVC")
D LOADVER(DIFILE,DIFLD,DIVCTMP)
;
D VER(DIFILE,DIROOT,.DA,DIVCTMP,.DIINDEX,.DIKEY)
K @DIVCTMP
Q
;
;=========================================
; VER(file#,fileRoot,.DA,tmp,.index,.key)
;=========================================
;Check that index is set. If index is a uniqueness index also
;check that key is unique, and that key fields are non-null.
;Called from INDEX^DIVR.
;In:
; DIFILE = [sub]file #
; DIROOT = closed [sub]file root
; .DA = DA array
; DIVCTMP = root where xref info and verification logic is stored
;Out:
; .DIINDEX = see VINDEX above
; .DIKEY = see VINDEX above
;
VER(DIFILE,DIROOT,DA,DIVCTMP,DIINDEX,DIKEY) ;
N DICHECK,DINULL,DIXR,DIXRNAM,X,X1,X2
N KEY,KFIL,KNAM,UNIQ
;
;Loop through the xrefs loaded in @DIVCTMP
S DIXR=0 F S DIXR=$O(@DIVCTMP@(DIFILE,DIXR)) Q:DIXR'=+DIXR D
. S DIXRNAM=$P(@DIVCTMP@(DIFILE,DIXR),U)
. D SETXARR^DIKC(DIFILE,DIXR,DIVCTMP,.DINULL) M X1=X,X2=X
. ;
. ;If no X values are null, but no index, set DIINDEX(name,xref#)
. I 'DINULL D
.. S DICHECK=$G(@DIVCTMP@(DIFILE,DIXR,"V"))
.. I DICHECK]"" X DICHECK E S DIINDEX(DIXRNAM,DIXR)=""
. ;
. ;If the xref is a uniqueness index for a key, set DIKEY() if
. ;key is not unique, or a key field is null.
. I $D(^DD("KEY","AU",DIXR)) D
.. S UNIQ=$S(DINULL:0,1:$$UNIQUE^DIKK2(DIFILE,DIXR,.X,.DA,DIVCTMP))
.. I 'UNIQ S KEY=0 F S KEY=$O(^DD("KEY","AU",DIXR,KEY)) Q:'KEY D
... Q:$D(^DD("KEY",KEY,0))[0 S KFIL=$P(^(0),U),KNAM=$P(^(0),U,2)
... S DIKEY(KFIL,KNAM,DIXRNAM)=$S(DINULL:"null",1:"uniq")
Q
;
;=============================
; CHK: Check input parameters
;=============================
;Out:
; DA = DA array
; DIFILE = File #
; DIROOT = Closed file root
; DIVERR = 1 : if there's a problem
;
CHK ;File is a required input parameter
I $G(DIFILE)="" D:DIFLAG["D" ERR^DIKCU2(202,"","","","FILE") D ERR Q
I $G(DIFLD)="" D:DIFLAG["D" ERR^DIKCU2(202,"","","","FIELD") D ERR Q
;
;Check DIREC and set DA array
N DIIENS
I $G(DIREC)'["," M DA=DIREC S DIIENS=$$IENS^DILF(.DA)
E S:DIREC'?.E1"," DIREC=DIREC_"," D DA^DILF(DIREC,.DA) S DIIENS=DIREC
I '$$VDA^DIKCU1(.DA,DIFLAG_"R") D ERR Q
;
;Check DIFLD
I '$$VFLD^DIKCU1(DIFILE,DIFLD,DIFLAG) D ERR Q
;
;Set DIFILE and DIROOT
N DILEV
I DIFILE=+$P(DIFILE,"E") D
. S DIROOT=$$FROOTDA^DIKCU(DIFILE,DIFLAG,.DILEV) I DIROOT="" D ERR Q
. I DILEV,$D(DA(DILEV))[0 D Q
.. D:DIFLAG["D" ERR^DIKCU2(205,"",$$IENS^DILF(.DA),"",DIFILE) D ERR
. S:DILEV DIROOT=$NA(@DIROOT)
. S DIFILE=$$FNUM^DIKCU(DIROOT,DIFLAG) I DIFILE="" D ERR
E D
. S DIROOT=DIFILE
. S:"(,"[$E(DIROOT,$L(DIROOT)) DIROOT=$$CREF^DILF(DIFILE)
. S DIFILE=$$FNUM^DIKCU(DIROOT,DIFLAG) I DIFILE="" D ERR Q
. S DILEV=$$FLEV^DIKCU(DIFILE,DIFLAG) I DILEV="" D ERR Q
. I DILEV,$D(DA(DILEV))[0 D Q
.. D:DIFLAG["D" ERR^DIKCU2(205,"",$$IENS^DILF(.DA),"",DIFILE) D ERR
Q
;
ERR ;Set error flag
S DIVERR=1
Q
;
;============================
; LOADVER(file#,field#,tmp)
;============================
;Load xref info and verification logic for file/field into @TMP.
;Also, for each regular xref with no set condition, set
; @TMP@(rootFile#,xref#,"V")=I $D(^index),^index=indexVal
; where,
; index = something like DIZ(9999,"BB",X(1),X(2),DA)
; indexVal = value of index, usually ""
;
;In:
; FILE = File #
; FIELD = Field #
; TMP = Root to store logic
;
LOADVER(FILE,FIELD,TMP) ;Load indexes into TMP array
N FIL,KL,SL,XR
;
;Load xref info for file/field into @TMP
D LOADFLD^DIKC1(FILE,FIELD,"KS","","",TMP,TMP)
;
;Set the "V" nodes, kill the "S" and "K" nodes
S FIL=0 F S FIL=$O(@TMP@(FIL)) Q:'FIL D
. S XR=0 F S XR=$O(@TMP@(FIL,XR)) Q:'XR D
.. I $P(@TMP@(FIL,XR),U,4)'="R"!$D(@TMP@(FIL,XR,"SC")) K @TMP@(FIL,XR) Q
.. S SL=$G(@TMP@(FIL,XR,"S")),KL=$G(@TMP@(FIL,XR,"K"))
.. I SL?1"S ^"1.E,KL?1"K ^"1.E D
... S @TMP@(FIL,XR,"V")="I $D("_$E(KL,3,999)_")#2,"_$E(SL,3,999)
.. K @TMP@(FIL,XR,"S"),@TMP@(FIL,XR,"K")
Q
;
;#202 The input parameter that identifies the |1| is missing or invalid.
;#601 The entry does not exist.
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIVC 5548 printed Sep 23, 2025@20:30:51 Page 2
DIVC ;SFISC/MKO-VERIFY INDEXES/KEYS ;2:47 PM 23 Jan 1998
+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 ; VINDEX(file,record,field,flag,.index,.key)
+9 ;============================================
+10 ;Programmer entry point to check the existence of indexes and
+11 ;key integrity for a single file/field/record. (Currently not used)
+12 ;In:
+13 ; DIFILE = file or subfile # (required)
+14 ; DIREC = DA array or IENS (required)
+15 ; DIFLD = field # (required)
+16 ; DIFLAG [ D : generate dialog errors
+17 ;Out:
+18 ; For invalid indexes/keys:
+19 ; .DIINDEX(indexName,index#) = "" : if an index is not set
+20 ; .DIKEY(file#,keyName,uiNumber) = null : if a key field is null
+21 ; uniq : if a key not unique
+22 ;
VINDEX(DIFILE,DIREC,DIFLD,DIFLAG,DIINDEX,DIKEY) ;
+1 NEW DA,DIROOT,DIVCTMP,DIVERR
+2 ;
+3 ;Initialization
+4 SET DIFLAG=$GET(DIFLAG)
SET DIVERR=0
+5 IF DIFLAG["D"
IF '$DATA(DIQUIET)
NEW DIQUIET
SET DIQUIET=1
+6 IF DIFLAG["D"
IF '$DATA(DIFM)
NEW DIFM
SET DIFM=1
DO INIZE^DIEFU
+7 ;
+8 ;Check and convert input paramaters
+9 DO CHK
if DIVERR
QUIT
+10 ;
+11 ;Load xref info
+12 SET DIVCTMP=$$GETTMP^DIKC1("DIVC")
+13 DO LOADVER(DIFILE,DIFLD,DIVCTMP)
+14 ;
+15 DO VER(DIFILE,DIROOT,.DA,DIVCTMP,.DIINDEX,.DIKEY)
+16 KILL @DIVCTMP
+17 QUIT
+18 ;
+19 ;=========================================
+20 ; VER(file#,fileRoot,.DA,tmp,.index,.key)
+21 ;=========================================
+22 ;Check that index is set. If index is a uniqueness index also
+23 ;check that key is unique, and that key fields are non-null.
+24 ;Called from INDEX^DIVR.
+25 ;In:
+26 ; DIFILE = [sub]file #
+27 ; DIROOT = closed [sub]file root
+28 ; .DA = DA array
+29 ; DIVCTMP = root where xref info and verification logic is stored
+30 ;Out:
+31 ; .DIINDEX = see VINDEX above
+32 ; .DIKEY = see VINDEX above
+33 ;
VER(DIFILE,DIROOT,DA,DIVCTMP,DIINDEX,DIKEY) ;
+1 NEW DICHECK,DINULL,DIXR,DIXRNAM,X,X1,X2
+2 NEW KEY,KFIL,KNAM,UNIQ
+3 ;
+4 ;Loop through the xrefs loaded in @DIVCTMP
+5 SET DIXR=0
FOR
SET DIXR=$ORDER(@DIVCTMP@(DIFILE,DIXR))
if DIXR'=+DIXR
QUIT
Begin DoDot:1
+6 SET DIXRNAM=$PIECE(@DIVCTMP@(DIFILE,DIXR),U)
+7 DO SETXARR^DIKC(DIFILE,DIXR,DIVCTMP,.DINULL)
MERGE X1=X,X2=X
+8 ;
+9 ;If no X values are null, but no index, set DIINDEX(name,xref#)
+10 IF 'DINULL
Begin DoDot:2
+11 SET DICHECK=$GET(@DIVCTMP@(DIFILE,DIXR,"V"))
+12 IF DICHECK]""
XECUTE DICHECK
IF '$TEST
SET DIINDEX(DIXRNAM,DIXR)=""
End DoDot:2
+13 ;
+14 ;If the xref is a uniqueness index for a key, set DIKEY() if
+15 ;key is not unique, or a key field is null.
+16 IF $DATA(^DD("KEY","AU",DIXR))
Begin DoDot:2
+17 SET UNIQ=$SELECT(DINULL:0,1:$$UNIQUE^DIKK2(DIFILE,DIXR,.X,.DA,DIVCTMP))
+18 IF 'UNIQ
SET KEY=0
FOR
SET KEY=$ORDER(^DD("KEY","AU",DIXR,KEY))
if 'KEY
QUIT
Begin DoDot:3
+19 if $DATA(^DD("KEY",KEY,0))[0
QUIT
SET KFIL=$PIECE(^(0),U)
SET KNAM=$PIECE(^(0),U,2)
+20 SET DIKEY(KFIL,KNAM,DIXRNAM)=$SELECT(DINULL:"null",1:"uniq")
End DoDot:3
End DoDot:2
End DoDot:1
+21 QUIT
+22 ;
+23 ;=============================
+24 ; CHK: Check input parameters
+25 ;=============================
+26 ;Out:
+27 ; DA = DA array
+28 ; DIFILE = File #
+29 ; DIROOT = Closed file root
+30 ; DIVERR = 1 : if there's a problem
+31 ;
CHK ;File is a required input parameter
+1 IF $GET(DIFILE)=""
if DIFLAG["D"
DO ERR^DIKCU2(202,"","","","FILE")
DO ERR
QUIT
+2 IF $GET(DIFLD)=""
if DIFLAG["D"
DO ERR^DIKCU2(202,"","","","FIELD")
DO ERR
QUIT
+3 ;
+4 ;Check DIREC and set DA array
+5 NEW DIIENS
+6 IF $GET(DIREC)'[","
MERGE DA=DIREC
SET DIIENS=$$IENS^DILF(.DA)
+7 IF '$TEST
if DIREC'?.E1","
SET DIREC=DIREC_","
DO DA^DILF(DIREC,.DA)
SET DIIENS=DIREC
+8 IF '$$VDA^DIKCU1(.DA,DIFLAG_"R")
DO ERR
QUIT
+9 ;
+10 ;Check DIFLD
+11 IF '$$VFLD^DIKCU1(DIFILE,DIFLD,DIFLAG)
DO ERR
QUIT
+12 ;
+13 ;Set DIFILE and DIROOT
+14 NEW DILEV
+15 IF DIFILE=+$PIECE(DIFILE,"E")
Begin DoDot:1
+16 SET DIROOT=$$FROOTDA^DIKCU(DIFILE,DIFLAG,.DILEV)
IF DIROOT=""
DO ERR
QUIT
+17 IF DILEV
IF $DATA(DA(DILEV))[0
Begin DoDot:2
+18 if DIFLAG["D"
DO ERR^DIKCU2(205,"",$$IENS^DILF(.DA),"",DIFILE)
DO ERR
End DoDot:2
QUIT
+19 if DILEV
SET DIROOT=$NAME(@DIROOT)
+20 SET DIFILE=$$FNUM^DIKCU(DIROOT,DIFLAG)
IF DIFILE=""
DO ERR
End DoDot:1
+21 IF '$TEST
Begin DoDot:1
+22 SET DIROOT=DIFILE
+23 if "(,"[$EXTRACT(DIROOT,$LENGTH(DIROOT))
SET DIROOT=$$CREF^DILF(DIFILE)
+24 SET DIFILE=$$FNUM^DIKCU(DIROOT,DIFLAG)
IF DIFILE=""
DO ERR
QUIT
+25 SET DILEV=$$FLEV^DIKCU(DIFILE,DIFLAG)
IF DILEV=""
DO ERR
QUIT
+26 IF DILEV
IF $DATA(DA(DILEV))[0
Begin DoDot:2
+27 if DIFLAG["D"
DO ERR^DIKCU2(205,"",$$IENS^DILF(.DA),"",DIFILE)
DO ERR
End DoDot:2
QUIT
End DoDot:1
+28 QUIT
+29 ;
ERR ;Set error flag
+1 SET DIVERR=1
+2 QUIT
+3 ;
+4 ;============================
+5 ; LOADVER(file#,field#,tmp)
+6 ;============================
+7 ;Load xref info and verification logic for file/field into @TMP.
+8 ;Also, for each regular xref with no set condition, set
+9 ; @TMP@(rootFile#,xref#,"V")=I $D(^index),^index=indexVal
+10 ; where,
+11 ; index = something like DIZ(9999,"BB",X(1),X(2),DA)
+12 ; indexVal = value of index, usually ""
+13 ;
+14 ;In:
+15 ; FILE = File #
+16 ; FIELD = Field #
+17 ; TMP = Root to store logic
+18 ;
LOADVER(FILE,FIELD,TMP) ;Load indexes into TMP array
+1 NEW FIL,KL,SL,XR
+2 ;
+3 ;Load xref info for file/field into @TMP
+4 DO LOADFLD^DIKC1(FILE,FIELD,"KS","","",TMP,TMP)
+5 ;
+6 ;Set the "V" nodes, kill the "S" and "K" nodes
+7 SET FIL=0
FOR
SET FIL=$ORDER(@TMP@(FIL))
if 'FIL
QUIT
Begin DoDot:1
+8 SET XR=0
FOR
SET XR=$ORDER(@TMP@(FIL,XR))
if 'XR
QUIT
Begin DoDot:2
+9 IF $PIECE(@TMP@(FIL,XR),U,4)'="R"!$DATA(@TMP@(FIL,XR,"SC"))
KILL @TMP@(FIL,XR)
QUIT
+10 SET SL=$GET(@TMP@(FIL,XR,"S"))
SET KL=$GET(@TMP@(FIL,XR,"K"))
+11 IF SL?1"S ^"1.E
IF KL?1"K ^"1.E
Begin DoDot:3
+12 SET @TMP@(FIL,XR,"V")="I $D("_$EXTRACT(KL,3,999)_")#2,"_$EXTRACT(SL,3,999)
End DoDot:3
+13 KILL @TMP@(FIL,XR,"S"),@TMP@(FIL,XR,"K")
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
+16 ;#202 The input parameter that identifies the |1| is missing or invalid.
+17 ;#601 The entry does not exist.
