source: FOIAVistA/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIEF.m@ 1683

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

initial load of FOIAVistA 6/30/08 version
File size: 6.8 KB
Line 
1DIEF ;SFISC/DPC-FILER DRIVER ;11:15 AM 25 Feb 2002
2 ;;22.0;VA FileMan;**1,11,101**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4FILE(DIEFFLAG,DIEFAR,DIEFOUT,DIEFADAR) ;
5FILEX ;
6 N DIEFF,DIEFCNOD,DIEFNODE,DIEFSPOT,DIEFDAS,DIEFIEN,DIEFRFLD,DIEFFLD,DIEFFVAL,DIEFOVAL,DIEFNVAL,DIEFTSRC,DIEFLOCK,DIEFECNT
7 N DIDATA,DIEFFLST,DIEFFREF,DIEFFXR,DIEFLEV,DIEFRLST,DIEFTMP,DIEFTREF
8 S DIEFFLAG=$G(DIEFFLAG)
9 I '$D(DIQUIET) N DIQUIET S DIQUIET=1
10 I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
11 I '$$VERFLG^DIEFU(DIEFFLAG,"ISKEOTU") G OUT
12 I DIEFFLAG["T",DIEFFLAG'["E" D BLD^DIALOG(301,DIEFFLAG,DIEFFLAG) G OUT
13 I '$$VROOT^DIEFU(DIEFAR) G OUT
14 I '($D(@DIEFAR)\10) D BLD^DIALOG(305,DIEFAR,DIEFAR) G OUT
15 I DIEFFLAG["K" N DIEFNOLK,DIEFLCKS D LOCK^DIEF1 I DIEFNOLK G OUT
16 ;batch conversion to internal and key validation if requested.
17 I DIEFFLAG["T" S DIEFECNT=$G(DIERR) D G:DIEFECNT'=$G(DIERR) OUT
18 . S DIEFAR("INT")="^TMP($J,""DIEF"")"
19 . D VALS^DIEVS("R"_$E("U",DIEFFLAG["U"),DIEFAR,DIEFAR("INT"))
20 . S DIEFAR("EXT")=DIEFAR,DIEFAR=DIEFAR("INT")
21 S DIEFTMP=$$GETTMP^DIKC1("DIEF")
22 D DRIVER
23OUT I $D(DIEFLOCK) D UNLOCK^DIEF1
24 I DIEFFLAG'["S",'$G(DIERR) K @$G(DIEFAR("EXT"),DIEFAR)
25 I $D(DIEFAR("INT")) K @DIEFAR("INT")
26 I $G(DIEFOUT)]"" D CALLOUT^DIEFU(DIEFOUT)
27 I $D(DIEFTMP) K @DIEFTMP
28 Q
29DRIVER ;
30 S DIEFF=""
31 F S DIEFF=$O(@DIEFAR@(DIEFF)) Q:DIEFF="" D
32 . I DIEFFLAG'["K",'$$VFILE^DIEFU(DIEFF,"D") Q
33 . S DIEFFREF=$$FROOTDA^DIKCU(DIEFF,"D",.DIEFLEV,.DIEFTREF) Q:DIEFFREF=""
34 . S DIEFDAS=""
35 . F S DIEFDAS=$O(@DIEFAR@(DIEFF,DIEFDAS)) Q:DIEFDAS="" D
36 . . N D,I,DA,S,DIOPER
37 . . S DIEFIEN=DIEFDAS
38 . . I ($E(DIEFIEN)="?"!($E(DIEFIEN)="+")),$G(DIEFADAR)]"" D
39 . . . I $E(DIEFIEN)="+" S DIOPER="A"
40 . . . E I $E(DIEFIEN,1,2)="?+",@DIEFADAR@($TR($P(DIEFIEN,","),"?+"),0)="+" S DIOPER="A"
41 . . . S DIEFIEN=$$ADDCONV^DIEF1(DIEFIEN,DIEFADAR)
42 . . S S=" " F S S=$O(@DIEFTMP@("DEL",DIEFF,S)) Q:S="" I ","_DIEFIEN?@(".E1"","_S_"""") S DIEFDAS=$C(127) Q
43 . . Q:DIEFDAS=$C(127)
44 . . I DIEFFLAG'["K" Q:'$$GOODIEN(DIEFF,DIEFIEN,DIEFLEV,"","D")
45 . . F I=0:1:DIEFLEV S D="D"_(DIEFLEV-I) N @D S (DA(I),@D)=$P(DIEFIEN,",",I+1)
46 . . S DA=DA(0) K DA(0)
47 . . S DIDATA=$NA(@DIEFFREF@(DA))
48 . . Q:'$$VENTRY(DIEFF,DIEFIEN,"D"_$E(9,DIEFFLAG["E"),DIDATA,DIEFTREF)
49 . . N DOREPL S DIEFRFLD="",DOREPL=0
50 . . F S DIEFRFLD=$O(@DIEFAR@(DIEFF,DIEFDAS,DIEFRFLD)) Q:DIEFRFLD="" D
51 . . . N DIEFNG
52 . . . S DIEFFLD=$$CHKFLD^DIEFU(DIEFF,DIEFRFLD) I 'DIEFFLD Q
53 . . . I DIEFFLD=.001 D BLD^DIALOG(520,".001",".001") Q
54 . . . S DIEFNVAL=@DIEFAR@(DIEFF,DIEFDAS,DIEFRFLD)
55 . . . I DIEFFLAG["E",DIEFFLAG'["T" D VAL Q:$D(DIEFNG)
56 . . . I DIEFFLD=.01,"@"[DIEFNVAL D PT01DEL Q
57 . . . S DIEFSPOT=$P(^DD(DIEFF,DIEFFLD,0),U,4)
58 . . . S DIEFNODE=$NA(@DIDATA@($P(DIEFSPOT,";")))
59 . . . S DIEFSPOT=$P(DIEFSPOT,";",2)
60 . . . I DIEFNODE'=$G(DIEFCNOD) D:DOREPL REPLACE S DIEFCNOD=DIEFNODE D RETRIEVE
61 . . . I DIEFNVAL="@" S DIEFNVAL=""
62 . . . D LOADFLD^DIKC1(DIEFF,DIEFFLD,"KS","",$NA(@DIEFTMP@("V")),"DIEFFXR",$NA(@DIEFTMP@("R")),.DIEFFLST,.DIEFRLST)
63 . . . I DIEFFLAG'["T",DIEFFLAG'["U",'$$SKEYCHK^DIEF1(DIEFF,DIEFFLD,DIEFNVAL,.DA,DIEFIEN,.DIEFFXR) K DIEFFXR Q
64 . . . D PUTDATA^DIEF1 Q:$D(DIEFNG)
65 . . . I DIEFNVAL'=$G(DIEFOVAL) D XRFAUD,FIREFLD
66 . . D REPLACE:DOREPL K DIEFCNOD
67 . . D FIREREC
68 Q
69PT01DEL ;
70 ;I '$D(^DD(DIEFF,0,"UP")) D Q
71 ;. N INT,EXT
72 ;. S INT(1)=$$FLDNM^DIEFU(DIEFF,DIEFFLD),INT(2)=$$FILENM^DIEFU(DIEFF),EXT("FILE")=DIEFF,EXT("FIELD")=DIEFFLD
73 ;. D BLD^DIALOG(712,.INT,.EXT)
74 S DIEFECNT=$G(DIERR)
75 N %,DIC,DIK S DIK=$$OREF^DILF($NA(@DIEFFREF)) D ^DIK
76 I DIEFECNT'=$G(DIERR) D HKERR^DILIBF(DIEFF,DIEFIEN,DIEFFLD,"cross reference")
77 N SB D SUBFILES^DIKCU(DIEFF,.SB) S SB(DIEFF)=""
78 S SB=0 F S SB=$O(SB(SB)) Q:'SB S @DIEFTMP@("DEL",SB,DIEFIEN)=""
79 S DIEFRFLD=$C(127),DOREPL=0
80 K @DIEFTMP@("R"),@DIEFTMP@("V")
81 Q
82VAL ;
83 N DIEFTYPE,DIEFINT
84 D DTYP^DIOU(DIEFF,DIEFFLD,.DIEFTYPE) Q:DIEFTYPE=5
85 D VAL^DIEV(DIEFF,DIEFIEN,DIEFFLD,"U",DIEFNVAL,.DIEFINT)
86 I DIEFINT'=U S DIEFNVAL=DIEFINT Q
87 S DIEFNG=1
88 Q
89REPLACE ;
90 S @DIEFCNOD=DIEFFVAL,DOREPL=0
91 Q
92RETRIEVE ;
93 S DIEFFVAL=$G(@DIEFCNOD)
94 Q
95 ;
96XRFAUD ;
97 I $D(^DD(DIEFF,"IX",DIEFFLD)) D REPLACE:$G(DOREPL),IX,RETRIEVE:$D(DOREPL)
98 I $D(^DD(DIEFF,"AUDIT",DIEFFLD)) D AUDIT
99 Q
100IX ;
101 N X,DIEFSORK
102 I DIEFOVAL'="" S DIEFSORK=2 D FIRE
103 I "@"'[DIEFNVAL S DIEFSORK=1 D FIRE
104 Q
105FIRE ;
106 N DIEFI,DICRREC
107 S:$D(DIEFTMP) DICRREC="TRIG^DIEF"
108 S DIEFI=0
109 F S DIEFI=$O(^DD(DIEFF,DIEFFLD,1,DIEFI)) Q:DIEFI="" D
110 . N I,Y,DIG,DIH,DIU,DIV,XMB,XMY
111 . S X=$S(DIEFSORK=1:DIEFNVAL,1:DIEFOVAL)
112 . N DIEFECNT S DIEFECNT=$G(DIERR)
113 . X ^(DIEFI,DIEFSORK) ;Naked indicator set in For loop, FIRE+2
114 . I DIEFECNT'=$G(DIERR) D HKERR^DILIBF(DIEFF,DIEFIEN,DIEFFLD,"cross reference")
115 Q
116AUDIT ;
117 N X,DP,DG,DIIX N DIANUM,C,Y
118 S DP=DIEFF,DG=1
119 I DIEFOVAL]"" S X=DIEFOVAL,DIIX="2^"_DIEFFLD D AUDIT^DIET
120 I "@"'[DIEFNVAL,(DIEFOVAL]""!(^DD(DIEFF,DIEFFLD,"AUDIT")'="e")) S X=DIEFNVAL,DIIX="3^"_DIEFFLD_$S(DIEFFLD=.01&(DIEFOVAL=""):"^A",1:"") D AUDIT^DIET
121 Q
122 ;
123FIREFLD ;Fire field-level xrefs
124 Q:'$D(DIEFTMP)
125 I $G(DIEFFLST)]""!($G(DIEFRLST)]"") D
126 . S:'$D(@DIEFTMP@("V",DIEFF,DIEFIEN,DIEFFLD,"O")) ^("O")=DIEFOVAL
127 ;
128 I $G(DIEFFLST)]"" D
129 . D:$G(DOREPL) REPLACE
130 . D FIRE^DIKC(DIEFF,.DA,"KS","DIEFFXR","O","",$E("C",$G(DIOPER)="A"))
131 . D:$D(DOREPL) RETRIEVE
132 K DIEFFXR,DIEFFLST
133 Q
134 ;
135FIREREC ;Fire record-level xrefs
136 N DIKEY
137 D FIRE^DIKC(DIEFF,.DA,"KS",$NA(@DIEFTMP@("R")),"O^"_$S(DIEFFLAG'["T"&(DIEFFLAG'["U"):"^K^N",1:""),.DIKEY,$E("C",$G(DIOPER)="A"))
138 D:$D(DIKEY)>9 RESTORE^DIEF1(.DIKEY,DIEFTMP)
139 K @DIEFTMP@("R"),@DIEFTMP@("V")
140 Q
141 ;
142GOODIEN(DIEFF,DIEFIEN,DIEFLEV,DA,DIEFFLG) ;
143 N ERR,P K DA
144 I DIEFIEN[",,"!($E(DIEFIEN)=",") D Q 0
145 . D:$G(DIEFFLG)["D" ERR^DIKCU2(307,"",DIEFIEN)
146 I $E(DIEFIEN,$L(DIEFIEN))'="," D Q 0
147 . D:$G(DIEFFLG)["D" ERR^DIKCU2(304,"",DIEFIEN)
148 I $L(DIEFIEN,",")-2'=DIEFLEV D Q 0
149 . D:$G(DIEFFLG)["D" ERR^DIKCU2(205,"",DIEFIEN,"",DIEFF)
150 S ERR=0 F P=1:1:$L(DIEFIEN,",")-1 D Q:ERR
151 . S DA(P-1)=$P(DIEFIEN,",",P)
152 . I DA(P-1)'=+$P(DA(P-1),"E")!(DA(P-1)'>0) D
153 .. K DA S ERR=1 D:$G(DIEFFLG)["D" ERR^DIKCU2(308,"",DIEFIEN)
154 Q:ERR 0
155 S DA=DA(0) K DA(0)
156 Q 1
157 ;
158VENTRY(DIEFF,DIEFIEN,DIEFFLG,DIDATA,DIEFTREF) ;
159 S DIEFFLG=$G(DIEFFLG)
160 ;
161 ;Get root of (sub)record and top level file
162 I $G(DIDATA)=""!(DIEFFLG[9&($G(DIEFTREF)="")) D Q:$G(DIDATA)="" 0
163 . N DA,DIEFD,DIEFLEV
164 . S DIEFD=$E("D",DIEFFLG["D")
165 . S DIDATA=$$FROOTDA^DIKCU(DIEFF,DIEFD,.DIEFLEV,.DIEFTREF) Q:DIDATA=""
166 . I '$$GOODIEN(DIEFF,DIEFIEN,DIEFLEV,.DA,DIEFD) S DIDATA="" Q
167 . S DIDATA=$NA(@DIDATA@(DA))
168 ;
169 ;Check null .01
170 I $P($G(@DIDATA@(0)),U)="" D Q 0
171 . D:DIEFFLG["D" ERR^DIKCU2(601,DIEFF,DIEFIEN)
172 ;
173 ;Check -9 node
174 I DIEFFLG[9,$D(@DIEFTREF@($P(DIEFIEN,",",$L(DIEFIEN,",")-1),-9)) D Q 0
175 . D:DIEFFLG["D" ERR^DIKCU2(602,DIEFF,DIEFIEN)
176 ;
177 Q 1
178 ;
179TRIG ;Called from trigger logic (from DICR via @DICRREC)
180 Q:'$D(DIEFTMP)
181 N DIEFRLST
182 D LOADFLD^DIKC1(DIH,DIG,"KS","",$NA(@DIEFTMP@("V")),"",$NA(@DIEFTMP@("R")),"",.DIEFRLST)
183 I $G(DIEFRLST)]"",'$D(@DIEFTMP@("V",DIH,DICRIENS,DIG,"O")) S ^("O")=DIU
184 Q
Note: See TracBrowser for help on using the repository browser.