source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFCEHU1.m@ 1259

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

initial load of WorldVistAEHR

File size: 8.8 KB
Line 
1VAFCEHU1 ;ALB/JLU,PTD-FILE UTILITIES FOR 391.98 ;11/21/02 12:24
2 ;;5.3;Registration;**149,255,307,477,685**;Aug 13, 1993
3 ;
4ADD(VAFCA,VAFCB) ;Main entry point to add an entry to 391.98
5 ;INPUTS VAFCA - This parameter contains a piece string of 4 elements
6 ;Date Received^Event date^From whom^patient IEN
7 ; Date Received - This is the date/time that the exception was received
8 ;at the facility. Must be in FM format
9 ; Event date - This is the date/time when the event occurred that caused
10 ;this information to be sent. Must be in FM format
11 ; From whom - This is who sent the information. This should be in a
12 ;free text format. There is a potential that exception could be coming
13 ;from sources other than what is listed in the institution file.
14 ;FORMAT of WHOM
15 ; prior to RG*1*8: institution name(sender name)
16 ; after RG*1*8: sending facility: station # -or- station #~domain
17 ;
18 ; Patient IEN - The patient file internal entry number.
19 ;
20 ; VAFCB - is an array storage structure. It can be either global
21 ;or local. The array should be in the following format.
22 ;Ex. A(file #,field #)=value
23 ; A(file #, field #)=value
24 ;
25 ;In the case of multiples us the following structure:
26 ;Ex. A(file #,field #,Subfile #, subfield #)=value
27 ;***NOTE*** THE SOFTWARE LOGIC TO HANDLE THIS MULTIPLE CASE HAS NOT
28 ;BEEN WRITTEN YET.
29 ;
30 ;**NOTE**
31 ;When setting info in the passage array please follow this format for
32 ;these exceptions.
33 ;-Unspecified or blank data should have no array element or an array
34 ;element set to the mumps null.
35 ;-If data from a sender can not be resolved then set
36 ; $P(array element,U,2)=1
37 ;-If you wish to delete what is in the receiving facilities field set
38 ;the array element to "@". EX. s X(1)="""@"""
39 ;
40 ;OUTPUTS
41 ; 0^error message - in the case of a failure
42 ; 1 - in the case that the entry is added
43 ;
44 N REC,EVT,WHO,PAT,RESLT,STATUS,LATEST
45 K ERR
46 S LATEST=""
47 I '$D(VAFCA) S ERR="0^Missing date/from parameter" G ADDQ
48 I '$D(VAFCB) S ERR="0^Missing array structure" G ADDQ
49 S REC=$P(VAFCA,U,1)
50 I REC']"" S ERR="0^Missing date of receipt" G ADDQ
51 S EVT=$P(VAFCA,U,2)
52 I EVT']"" S ERR="0^Missing date of event" G ADDQ
53 S WHO=$$WHO^VAFCEHU4($P(VAFCA,"^",3))
54 I WHO']"" S ERR="0^Missing who sent the information" G ADDQ
55 S PAT=$P(VAFCA,U,4)
56 I PAT']"" S ERR="0^Missing patient pointer" G ADDQ
57 I '$D(^DPT(PAT,0)) S ERR="0^Patient not defined" G ADDQ
58 I '$O(@VAFCB@("")) S ERR="0^Missing array storage structure" G ADDQ
59 ;There can be more than one patient update for a given day
60 ;resulting from different fields being edited.
61 ;I $D(^DGCN(391.98,"AKY",PAT,WHO,EVT)) S ERR="0^Entry already exists." G ADDQ
62 ;
63 ;update select edited fields and check for any differences
64 D EN^VAFCEHU3 I '$G(VAFCQ) S ERR="0^No exception needed" K VAFCQ G ADDQ
65 K VAFCQ
66 ;check for other entries for this date
67 S LATEST=$$CHKDATE(EVT,WHO,PAT)
68 ;if other entries than retire them based upon the event date
69 S STATUS=$S(LATEST:"ACTION REQUIRED",1:"RETIRED DATA")
70 ;
71 S (RESLT,RESLT(1))=$$EXCPTN(REC,EVT,WHO,PAT,STATUS)
72 I RESLT=-1 S ERR="0^Adding entry failed" G ADDQ
73 S RESLT=$$DATA(+RESLT,VAFCB)
74 I 'RESLT S ERR="0^Adding element failed"
75 ;
76ADDQ ;
77 I LATEST,'$D(ERR) D RETIRE(EVT,WHO,PAT)
78 Q $S($D(ERR):ERR,1:1)
79 ;
80CHKDATE(EVT,WHO,PAT) ;
81 N AFTER
82 S AFTER=$O(^DGCN(391.98,"AKY",PAT,WHO,EVT)) ;there is another date after
83 Q $S(AFTER:0,1:1)
84 ;
85RETIRE(EVT,WHO,PAT) ; Retire all previous entries from same site
86 N LP,ACTION,EDIT S LP=0
87 ;ien of action required
88 S ACTION=$O(^DGCN(391.984,"B","ACTION REQUIRED",0))
89 Q:'ACTION
90 ;looping to get all action required for "from" site
91 F S LP=$O(^DGCN(391.98,"AKY",PAT,WHO,LP)) Q:'LP D
92 .N ENTRY,DATA,XX,ELIEN,NODE
93 .S ENTRY=0
94 .F S ENTRY=$O(^DGCN(391.98,"AKY",PAT,WHO,LP,ENTRY)) Q:'ENTRY!(ENTRY=+RESLT(1)) D
95 ..S DATA=$G(^DGCN(391.98,ENTRY,0))
96 ..;sets the status to retired
97 ..I DATA,$P(DATA,U,4)=ACTION D S XX=$$EDIT(ENTRY,"RETIRED DATA")
98 ...;build array of EDITED elements from all entries being retired
99 ...S ELIEN=0
100 ...F S ELIEN=$O(^DGCN(391.99,"B",ENTRY,ELIEN)) Q:'ELIEN S NODE=$G(^DGCN(391.99,ELIEN,0)) I NODE,$P(NODE,U,5)=1 S EDIT($P(NODE,U,2),$P(NODE,U,3))=""
101 ..Q
102 ;mark EDITED fields in remaining entry
103 Q:'$O(EDIT(0))
104 N ELIEN,NODE,P2,P3 S ELIEN=0,DIE="^DGCN(391.99,",DR=".05///1"
105 F S ELIEN=$O(^DGCN(391.99,"B",(+RESLT(1)),ELIEN)) Q:'ELIEN D
106 .S NODE=$G(^DGCN(391.99,ELIEN,0)),(P2,P3)="" I NODE S P2=$P(NODE,U,2),P3=$P(NODE,U,3) I $D(EDIT(P2,P3)) D
107 ..L +^DGCN(391.99,ELIEN):60 ;**255
108 ..S DA=ELIEN D ^DIE
109 ..L -^DGCN(391.99,ELIEN) ;**255
110 K DA,DIE,DR,EDIT
111 Q
112 ;
113EXCPTN(REC,EVT,WHO,PAT,VAFCA) ;
114 N Y
115 K DIC,DA,DD,DO
116 S DGSENFLG="" ;**255
117 S DLAYGO=391.98
118 S DIC="^DGCN(391.98,"
119 S DIC(0)="LI"
120 S X=PAT
121 S DIC("DR")=".02///"_REC_";.03///"_EVT_";.04///"_VAFCA_";50///"_WHO
122 D FILE^DICN
123 K DIC,DLAYGO,X,DGSENFLG ;**255
124 Q Y
125 ;
126DATA(VAFCA,VAFCB) ;
127 N ADDED,LP,LP1,VAR
128 F LP=0:0 S LP=$O(@VAFCB@(LP)) Q:'LP DO
129 .F LP1=0:0 S LP1=$O(@VAFCB@(LP,LP1)) Q:'LP1 DO
130 ..K DIC,DA,DD,DO,VAFCE
131 ..S DLAYGO=391.99
132 ..S DIC="^DGCN(391.99,"
133 ..S DIC(0)="LI" ;**477 added 'I' to suppress incoming filer from generating bulletins
134 ..S X=VAFCA
135 ..S VAR=@VAFCB@(LP,LP1)
136 ..I (@VAFCB@(2,"FLD")[LP1_";"),(VAR]"") S VAFCE=1
137 ..S DIC("DR")=".02///"_LP_";.03///"_LP1_";.05///"_$G(VAFCE)_";.06///"_$P(VAR,U,2)_";50////^S X=$P(VAR,U)"
138 ..D FILE^DICN
139 ..I Y>0 S ADDED=1
140 ..Q
141 .Q
142 Q $S($D(ADDED):1,1:0)
143 ;
144CHK(A) ;
145 ;INPUT - A This parameter contains a piece string of 3 elements
146 ; patient dfn^event date/time^from whom
147 ;These are the key element to finding the entry in the patient data
148 ;exception file.
149 ;
150 ;Patient DFN is the internal entry number of the patient in the patient
151 ;file.
152 ;
153 ;event date/time is the date/time the event took place at the facility
154 ;that sent the data. This date must be in FM format.
155 ;
156 ;from whom is who sent this information to this medical center.
157 ;
158 ;OUTPUT
159 ; ZERO(0) if nothing found
160 ; ZERO(0)^error description if an error found
161 ; IEN of the entry in the patient data exception file if found
162 ;
163 N FOUND,PAT,EVT,WHO
164 S FOUND=0
165 I '$D(A) S FOUND="0^Input parameter missing." G CHKQ
166 S PAT=$P(A,U,1)
167 I PAT']"" S FOUND="0^No patient DFN defined." G CHKQ
168 I '$D(^DPT(PAT,0)) S FOUND="0^No patient with this DFN." G CHKQ
169 S EVT=$P(A,U,2)
170 I EVT']"" S FOUND="0^Date of event not defined." G CHKQ
171 S WHO=$$WHO^VAFCEHU4($P(A,U,3))
172 I WHO']"" S FOUND="0^Who sent the information is not defined." G CHKQ
173 ;
174 I $D(^DGCN(391.98,"AKY",PAT,WHO,EVT)) DO
175 .S FOUND=$O(^(EVT,"")) ;naked on the ^dgcn aky cross ref.
176 .I '$D(^DGCN(391.98,FOUND,0)) S FOUND=0
177 .Q
178 ;
179CHKQ Q FOUND
180 ;
181DELEXCPT(IEN) ;
182 ;This entry point deletes the entire exception from the file 391.98
183 ;and 391.99
184 ;INPUTS
185 ;IEN is the IEN of the entry in 391.98 it can be obtained from the call
186 ; to the CHK line tag.
187 ;
188 ;OUTPUT
189 ;ZERO(0) - if a problem or no deletion
190 ;ONE(1) - if deletion occurred
191 ;
192 I '$D(IEN) S ERR="0^Input parameter missing." G DELQ
193 I IEN']"" S ERR="0^Input parameter undefined." G DELQ
194 I '$D(^DGCN(391.98,IEN,0)) S ERR="0^Exception data missing." G DELQ
195 D DELDATA(IEN,.ERR)
196 ;
197 S DIK="^DGCN(391.98,"
198 S DA=IEN
199 D ^DIK
200 K DIK,DA
201 S ERR=1
202 ;
203DELQ Q ERR
204 ;
205DELDATA(IEN,ERR) ;
206 N LP
207 F LP=0:0 S LP=$O(^DGCN(391.99,"B",IEN,LP)) Q:'LP DO
208 .I '$D(^DGCN(391.99,LP,0)) Q
209 .S DIK="^DGCN(391.99,"
210 .S DA=LP
211 .D ^DIK
212 .K DA,DIK
213 .S ERR=1
214 .Q
215 Q
216 ;
217EDIT(IEN,STAT) ;
218 ;This entry point allows the editing of the status of an exception.
219 ;INPUT
220 ;IEN - the ien for an entry from 391.98
221 ;STAT - the new status.
222 ;
223 ;OUTPUTS
224 ;ZERO(0)^ description if an error
225 ;1 if changed
226 N ERR
227 ;
228 I '$D(IEN) S ERR="0^IEN not defined." G EDITQ
229 I IEN']"" S ERR="0^IEN is null." G EDITQ
230 I '$D(STAT) S ERR="0^Status is not defined." G EDITQ
231 I STAT']"" S ERR="0^Status is null." G EDITQ
232 I '$D(^DGCN(391.98,IEN,0)) S ERR="0^No entry for the IEN." G EDITQ
233 ;
234 N DIE,DA,DR
235 S DIE="^DGCN(391.98,"
236 S DA=IEN
237 S DR=".04///"_STAT
238 D ^DIE
239 S ERR=1
240 ;
241EDITQ Q ERR
242 ;
243LOCK(IEN) ;this function call will check the status of the exception and
244 ;set it to being reviewed if it is able. Exceptions that are being
245 ;reviewed, data rejected, merge complete or retired data can not be
246 ;set to being reviewed and thus accessed.
247 ;
248 ;INPUT - IEN the ien of the exception
249 ;
250 ;OUTPUT - 1 if the exception was able to be locked/ status turned to
251 ; being reviewed.
252 ; 0^description if the exception was not able to be "locked"
253 ;
254 N ERR,STAT,DATA
255 I '$D(IEN) S ERR="0^No input." G LCKQ
256 I IEN']"" S ERR="0^Null input." G LCKQ
257 L +^DGCN(391.98,IEN):0 I '$T S ERR="0^Exception is currently locked." G LCKQ ;**255
258 S DATA=$G(^DGCN(391.98,IEN,0))
259 I DATA="" S ERR="0^Exception not found." G LCKQ
260 S STAT=$P(DATA,U,4)
261 I STAT']"" S ERR="0^Status not defined." G LCKQ
262 S STAT=$G(^DGCN(391.984,STAT,0))
263 I STAT="" S ERR="0^Status not found." G LCKQ
264 I $P(STAT,U,2)'="AR",($P(STAT,U,2)'="DE") S ERR="0^"_$P(STAT,U,1) G LCKQ
265 I $$EDIT(IEN,"BR") S ERR="1^OK"
266 E S ERR="0^Could not change status."
267 ;
268LCKQ Q ERR
Note: See TracBrowser for help on using the repository browser.