153 lines
5.1 KiB
Mathematica
153 lines
5.1 KiB
Mathematica
DIVC ;SFISC/MKO-VERIFY INDEXES/KEYS ;2:47 PM 23 Jan 1998
|
|
;;22.0;VA FileMan;;Mar 30, 1999
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;============================================
|
|
; 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.
|