source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIVC.m@ 1474

Last change on this file since 1474 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 5.1 KB
Line 
1DIVC ;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 ;
20VINDEX(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 ;
54VER(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 ;
86CHK ;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 ;
116ERR ;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 ;
135LOADVER(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.
Note: See TracBrowser for help on using the repository browser.