[613] | 1 | DIVC ;SFISC/MKO-VERIFY INDEXES/KEYS ;2:47 PM 23 Jan 1998
|
---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
| 4 | ;============================================
|
---|
| 5 | ; VINDEX(file,record,field,flag,.index,.key)
|
---|
| 6 | ;============================================
|
---|
| 7 | ;Programmer entry point to check the existence of indexes and
|
---|
| 8 | ;key integrity for a single file/field/record. (Currently not used)
|
---|
| 9 | ;In:
|
---|
| 10 | ; DIFILE = file or subfile # (required)
|
---|
| 11 | ; DIREC = DA array or IENS (required)
|
---|
| 12 | ; DIFLD = field # (required)
|
---|
| 13 | ; DIFLAG [ D : generate dialog errors
|
---|
| 14 | ;Out:
|
---|
| 15 | ; For invalid indexes/keys:
|
---|
| 16 | ; .DIINDEX(indexName,index#) = "" : if an index is not set
|
---|
| 17 | ; .DIKEY(file#,keyName,uiNumber) = null : if a key field is null
|
---|
| 18 | ; uniq : if a key not unique
|
---|
| 19 | ;
|
---|
| 20 | VINDEX(DIFILE,DIREC,DIFLD,DIFLAG,DIINDEX,DIKEY) ;
|
---|
| 21 | N DA,DIROOT,DIVCTMP,DIVERR
|
---|
| 22 | ;
|
---|
| 23 | ;Initialization
|
---|
| 24 | S DIFLAG=$G(DIFLAG),DIVERR=0
|
---|
| 25 | I DIFLAG["D",'$D(DIQUIET) N DIQUIET S DIQUIET=1
|
---|
| 26 | I DIFLAG["D",'$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
|
---|
| 27 | ;
|
---|
| 28 | ;Check and convert input paramaters
|
---|
| 29 | D CHK Q:DIVERR
|
---|
| 30 | ;
|
---|
| 31 | ;Load xref info
|
---|
| 32 | S DIVCTMP=$$GETTMP^DIKC1("DIVC")
|
---|
| 33 | D LOADVER(DIFILE,DIFLD,DIVCTMP)
|
---|
| 34 | ;
|
---|
| 35 | D VER(DIFILE,DIROOT,.DA,DIVCTMP,.DIINDEX,.DIKEY)
|
---|
| 36 | K @DIVCTMP
|
---|
| 37 | Q
|
---|
| 38 | ;
|
---|
| 39 | ;=========================================
|
---|
| 40 | ; VER(file#,fileRoot,.DA,tmp,.index,.key)
|
---|
| 41 | ;=========================================
|
---|
| 42 | ;Check that index is set. If index is a uniqueness index also
|
---|
| 43 | ;check that key is unique, and that key fields are non-null.
|
---|
| 44 | ;Called from INDEX^DIVR.
|
---|
| 45 | ;In:
|
---|
| 46 | ; DIFILE = [sub]file #
|
---|
| 47 | ; DIROOT = closed [sub]file root
|
---|
| 48 | ; .DA = DA array
|
---|
| 49 | ; DIVCTMP = root where xref info and verification logic is stored
|
---|
| 50 | ;Out:
|
---|
| 51 | ; .DIINDEX = see VINDEX above
|
---|
| 52 | ; .DIKEY = see VINDEX above
|
---|
| 53 | ;
|
---|
| 54 | VER(DIFILE,DIROOT,DA,DIVCTMP,DIINDEX,DIKEY) ;
|
---|
| 55 | N DICHECK,DINULL,DIXR,DIXRNAM,X,X1,X2
|
---|
| 56 | N KEY,KFIL,KNAM,UNIQ
|
---|
| 57 | ;
|
---|
| 58 | ;Loop through the xrefs loaded in @DIVCTMP
|
---|
| 59 | S DIXR=0 F S DIXR=$O(@DIVCTMP@(DIFILE,DIXR)) Q:DIXR'=+DIXR D
|
---|
| 60 | . S DIXRNAM=$P(@DIVCTMP@(DIFILE,DIXR),U)
|
---|
| 61 | . D SETXARR^DIKC(DIFILE,DIXR,DIVCTMP,.DINULL) M X1=X,X2=X
|
---|
| 62 | . ;
|
---|
| 63 | . ;If no X values are null, but no index, set DIINDEX(name,xref#)
|
---|
| 64 | . I 'DINULL D
|
---|
| 65 | .. S DICHECK=$G(@DIVCTMP@(DIFILE,DIXR,"V"))
|
---|
| 66 | .. I DICHECK]"" X DICHECK E S DIINDEX(DIXRNAM,DIXR)=""
|
---|
| 67 | . ;
|
---|
| 68 | . ;If the xref is a uniqueness index for a key, set DIKEY() if
|
---|
| 69 | . ;key is not unique, or a key field is null.
|
---|
| 70 | . I $D(^DD("KEY","AU",DIXR)) D
|
---|
| 71 | .. S UNIQ=$S(DINULL:0,1:$$UNIQUE^DIKK2(DIFILE,DIXR,.X,.DA,DIVCTMP))
|
---|
| 72 | .. I 'UNIQ S KEY=0 F S KEY=$O(^DD("KEY","AU",DIXR,KEY)) Q:'KEY D
|
---|
| 73 | ... Q:$D(^DD("KEY",KEY,0))[0 S KFIL=$P(^(0),U),KNAM=$P(^(0),U,2)
|
---|
| 74 | ... S DIKEY(KFIL,KNAM,DIXRNAM)=$S(DINULL:"null",1:"uniq")
|
---|
| 75 | Q
|
---|
| 76 | ;
|
---|
| 77 | ;=============================
|
---|
| 78 | ; CHK: Check input parameters
|
---|
| 79 | ;=============================
|
---|
| 80 | ;Out:
|
---|
| 81 | ; DA = DA array
|
---|
| 82 | ; DIFILE = File #
|
---|
| 83 | ; DIROOT = Closed file root
|
---|
| 84 | ; DIVERR = 1 : if there's a problem
|
---|
| 85 | ;
|
---|
| 86 | CHK ;File is a required input parameter
|
---|
| 87 | I $G(DIFILE)="" D:DIFLAG["D" ERR^DIKCU2(202,"","","","FILE") D ERR Q
|
---|
| 88 | I $G(DIFLD)="" D:DIFLAG["D" ERR^DIKCU2(202,"","","","FIELD") D ERR Q
|
---|
| 89 | ;
|
---|
| 90 | ;Check DIREC and set DA array
|
---|
| 91 | N DIIENS
|
---|
| 92 | I $G(DIREC)'["," M DA=DIREC S DIIENS=$$IENS^DILF(.DA)
|
---|
| 93 | E S:DIREC'?.E1"," DIREC=DIREC_"," D DA^DILF(DIREC,.DA) S DIIENS=DIREC
|
---|
| 94 | I '$$VDA^DIKCU1(.DA,DIFLAG_"R") D ERR Q
|
---|
| 95 | ;
|
---|
| 96 | ;Check DIFLD
|
---|
| 97 | I '$$VFLD^DIKCU1(DIFILE,DIFLD,DIFLAG) D ERR Q
|
---|
| 98 | ;
|
---|
| 99 | ;Set DIFILE and DIROOT
|
---|
| 100 | N DILEV
|
---|
| 101 | I DIFILE=+$P(DIFILE,"E") D
|
---|
| 102 | . S DIROOT=$$FROOTDA^DIKCU(DIFILE,DIFLAG,.DILEV) I DIROOT="" D ERR Q
|
---|
| 103 | . I DILEV,$D(DA(DILEV))[0 D Q
|
---|
| 104 | .. D:DIFLAG["D" ERR^DIKCU2(205,"",$$IENS^DILF(.DA),"",DIFILE) D ERR
|
---|
| 105 | . S:DILEV DIROOT=$NA(@DIROOT)
|
---|
| 106 | . S DIFILE=$$FNUM^DIKCU(DIROOT,DIFLAG) I DIFILE="" D ERR
|
---|
| 107 | E D
|
---|
| 108 | . S DIROOT=DIFILE
|
---|
| 109 | . S:"(,"[$E(DIROOT,$L(DIROOT)) DIROOT=$$CREF^DILF(DIFILE)
|
---|
| 110 | . S DIFILE=$$FNUM^DIKCU(DIROOT,DIFLAG) I DIFILE="" D ERR Q
|
---|
| 111 | . S DILEV=$$FLEV^DIKCU(DIFILE,DIFLAG) I DILEV="" D ERR Q
|
---|
| 112 | . I DILEV,$D(DA(DILEV))[0 D Q
|
---|
| 113 | .. D:DIFLAG["D" ERR^DIKCU2(205,"",$$IENS^DILF(.DA),"",DIFILE) D ERR
|
---|
| 114 | Q
|
---|
| 115 | ;
|
---|
| 116 | ERR ;Set error flag
|
---|
| 117 | S DIVERR=1
|
---|
| 118 | Q
|
---|
| 119 | ;
|
---|
| 120 | ;============================
|
---|
| 121 | ; LOADVER(file#,field#,tmp)
|
---|
| 122 | ;============================
|
---|
| 123 | ;Load xref info and verification logic for file/field into @TMP.
|
---|
| 124 | ;Also, for each regular xref with no set condition, set
|
---|
| 125 | ; @TMP@(rootFile#,xref#,"V")=I $D(^index),^index=indexVal
|
---|
| 126 | ; where,
|
---|
| 127 | ; index = something like DIZ(9999,"BB",X(1),X(2),DA)
|
---|
| 128 | ; indexVal = value of index, usually ""
|
---|
| 129 | ;
|
---|
| 130 | ;In:
|
---|
| 131 | ; FILE = File #
|
---|
| 132 | ; FIELD = Field #
|
---|
| 133 | ; TMP = Root to store logic
|
---|
| 134 | ;
|
---|
| 135 | LOADVER(FILE,FIELD,TMP) ;Load indexes into TMP array
|
---|
| 136 | N FIL,KL,SL,XR
|
---|
| 137 | ;
|
---|
| 138 | ;Load xref info for file/field into @TMP
|
---|
| 139 | D LOADFLD^DIKC1(FILE,FIELD,"KS","","",TMP,TMP)
|
---|
| 140 | ;
|
---|
| 141 | ;Set the "V" nodes, kill the "S" and "K" nodes
|
---|
| 142 | S FIL=0 F S FIL=$O(@TMP@(FIL)) Q:'FIL D
|
---|
| 143 | . S XR=0 F S XR=$O(@TMP@(FIL,XR)) Q:'XR D
|
---|
| 144 | .. I $P(@TMP@(FIL,XR),U,4)'="R"!$D(@TMP@(FIL,XR,"SC")) K @TMP@(FIL,XR) Q
|
---|
| 145 | .. S SL=$G(@TMP@(FIL,XR,"S")),KL=$G(@TMP@(FIL,XR,"K"))
|
---|
| 146 | .. I SL?1"S ^"1.E,KL?1"K ^"1.E D
|
---|
| 147 | ... S @TMP@(FIL,XR,"V")="I $D("_$E(KL,3,999)_")#2,"_$E(SL,3,999)
|
---|
| 148 | .. K @TMP@(FIL,XR,"S"),@TMP@(FIL,XR,"K")
|
---|
| 149 | Q
|
---|
| 150 | ;
|
---|
| 151 | ;#202 The input parameter that identifies the |1| is missing or invalid.
|
---|
| 152 | ;#601 The entry does not exist.
|
---|