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

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

initial load of FOIAVistA 6/30/08 version
File size: 8.6 KB
Line 
1DGPFHLR ;ALB/RPM - PRF HL7 RECEIVE DRIVERS ; 8/14/06 12:01pm
2 ;;5.3;Registration;**425,650**;Aug 13, 1993;Build 3
3 ;
4RCV ;Receive all message types and route to message specific receiver
5 ;
6 ;This procedure is the main driver entry point for receiving all
7 ;message types (ORU, ACK, QRY and ORF) for patient record flag
8 ;assignment sharing.
9 ;
10 ;All procedures and functions assume that all VistA HL7 environment
11 ;variables are properly initialized and will produce a fatal error if
12 ;they are missing.
13 ;
14 ;The received message is copied to a temporary work global for
15 ;processing. The message type is determined from the MSH segment and
16 ;a receive processing procedure specific to the message type is called.
17 ;(Ex. ORU~R01 message calls procedure: RCVORU). The specific receive
18 ;processing procedure calls a message specific parse procedure to
19 ;validate the message data and return data arrays for storage. If no
20 ;parse errors are reported during validation, then the data arrays are
21 ;stored by the receive processing procedure. Control, along with any
22 ;parse validation errors, is then passed to the message specific send
23 ;processing procedures to build and transmit the acknowledgment and
24 ;query results messages.
25 ;
26 ; The message specific procedures are as follows:
27 ;
28 ; Message Receive Procedure Parse Procedure Send Procedure
29 ; ------- ----------------- ---------------- --------------
30 ; ORU~R01 RCVORU^DGPFHLR PARSORU^DGPFHLU SNDACK^DGPFHLS
31 ; ACK~R01 RCVACK^DGPFHLR PARSACK^DGPFHLU4 N/A
32 ; QRY~R02 RCVQRY^DGPFHLR PARSQRY^DGPFHLQ3 SNDORF^DGPFHLS
33 ; ORF~R04 RCVORF^DGPFHLR PARSORF^DGPFHLQ3 N/A
34 ;
35 N DGCNT
36 N DGMSGTYP
37 N DGSEG
38 N DGSEGCNT
39 N DGWRK
40 ;
41 S DGWRK=$NA(^TMP("DGPFHL7",$J))
42 K @DGWRK
43 ;
44 ;load work global with segments
45 F DGSEGCNT=1:1 X HLNEXT Q:HLQUIT'>0 D
46 . S DGCNT=0
47 . S @DGWRK@(DGSEGCNT,DGCNT)=HLNODE
48 . F S DGCNT=$O(HLNODE(DGCNT)) Q:'DGCNT D
49 . . S @DGWRK@(DGSEGCNT,DGCNT)=HLNODE(DGCNT)
50 ;
51 ;get message type from "MSH"
52 I $$NXTSEG^DGPFHLUT(DGWRK,0,HL("FS"),.DGSEG),$G(DGSEG("TYPE"))="MSH" D
53 . S DGMSGTYP=$P(DGSEG(9),$E(HL("ECH"),1),1)
54 . ;HLMTIENS is only required by RCVORU and RCVQRY, thus $GET
55 . I DGMSGTYP=HL("MTN") D @("RCV"_DGMSGTYP_"(DGWRK,$G(HLMTIENS),.HL)")
56 ;
57 ;cleanup
58 K @DGWRK
59 Q
60 ;
61RCVORU(DGWRK,DGMIEN,DGHL) ;Receive ORU Message Types (ORU~R01)
62 ;
63 ; Input:
64 ; DGWRK - name of work global containing segments
65 ; DGMIEN - IEN of message entry in file #773
66 ; DGHL - HL environment array
67 ;
68 ; Output:
69 ; none
70 ;
71 N DGORU
72 N DGSEGERR
73 N DGSTOERR ;store error array
74 N DGACKTYP
75 ;
76 S DGORU=$NA(^TMP("DGPF",$J))
77 K @DGORU
78 D PARSORU^DGPFHLU(DGWRK,.DGHL,DGORU,.DGSEGERR)
79 ;
80 I '$D(DGSEGERR),$$STOORU(DGORU,.DGSTOERR) D
81 . S DGACKTYP="AA"
82 E D
83 . S DGACKTYP="AE"
84 ;
85 D SNDACK^DGPFHLS(DGACKTYP,DGMIEN,.DGHL,.DGSEGERR,.DGSTOERR)
86 ;
87 ;cleanup
88 K @DGORU
89 Q
90 ;
91STOORU(DGORU,DGERR) ;store ORU data array
92 ;
93 ; Input:
94 ; DGORU - parsed ORU segment data array
95 ;
96 ; Output:
97 ; Function value - 1 on success; 0 on failure
98 ; DGERR - defined on failure
99 ;
100 N DGADT ;assignment date
101 N DGCNT ;count of assignment histories sent
102 N DGPFA ;assignment data array
103 N DGPFAH ;assignment history data array
104 N DGSINGLE ;flag to indicate a single history update
105 ;
106 ;
107 S DGPFA("SNDFAC")=$G(@DGORU@("SNDFAC"))
108 S DGPFA("DFN")=$G(@DGORU@("DFN"))
109 S DGPFA("FLAG")=$G(@DGORU@("FLAG"))
110 ;
111 ;init STATUS as a placeholder, $$STATUS^DGPFUT sets value in loop
112 S DGPFA("STATUS")=""
113 S DGPFA("OWNER")=$G(@DGORU@("OWNER"))
114 S DGPFA("ORIGSITE")=$G(@DGORU@("ORIGSITE"))
115 M DGPFA("NARR")=@DGORU@("NARR")
116 ;
117 ;count number of assignment histories sent
118 S (DGADT,DGCNT)=0
119 F S DGADT=$O(@DGORU@(DGADT)) Q:'DGADT S DGCNT=DGCNT+1
120 S DGSINGLE=$S(DGCNT>1:0,1:1)
121 S DGADT=0
122 ;
123 ;process only the last history action when assignment already exists
124 I 'DGSINGLE,$$FNDASGN^DGPFAA(DGPFA("DFN"),DGPFA("FLAG")) D
125 . S DGADT=+$O(@DGORU@($O(@DGORU@(9999999.999999),-1)),-1)
126 . S DGSINGLE=1
127 ;
128 F S DGADT=$O(@DGORU@(DGADT)) Q:'DGADT D Q:$D(DGERR)
129 . N DGPFAH ;assignment history data array
130 . ;
131 . S DGPFAH("ASSIGNDT")=DGADT
132 . S DGPFAH("ACTION")=$G(@DGORU@(DGADT,"ACTION"))
133 . S DGPFAH("ENTERBY")=.5 ;POSTMASTER
134 . S DGPFAH("APPRVBY")=.5 ;POSTMASTER
135 . M DGPFAH("COMMENT")=@DGORU@(DGADT,"COMMENT")
136 . ;
137 . ;calculate the assignment STATUS from the ACTION
138 . S DGPFA("STATUS")=$$STATUS^DGPFUT(DGPFAH("ACTION"))
139 . ;validate before filing for single updates and new assignments
140 . I DGSINGLE!(DGPFAH("ACTION")=1) D
141 . . I $$STOHL7^DGPFAA3(.DGPFA,.DGPFAH,"DGERR")
142 . ;otherwise, just file it
143 . E D
144 . . I $$STOALL^DGPFAA(.DGPFA,.DGPFAH,.DGERR)
145 ;
146 ;convert dialog to dialog code
147 I $D(DGERR) S DGERR=$G(DGERR("DIERR",1))
148 ;
149 Q '$D(DGERR)
150 ;
151RCVACK(DGWRK,DGMIEN,DGHL) ;Receive ACK Message Types (ACK~R01)
152 ;
153 ; Input:
154 ; DGWRK - name of work global containing segments
155 ; DGMIEN - IEN of message entry in file #773
156 ; DGHL - HL environment array
157 ;
158 ; Output:
159 ; none
160 ;
161 N DGACK ;ACK data array
162 N DGERR ;error array
163 N DGLIEN ;HL7 transmission log IEN
164 ;
165 D PARSACK^DGPFHLU4(DGWRK,.DGHL,.DGACK,.DGERR)
166 S DGLIEN=$$FNDLOG^DGPFHLL(26.17,$G(DGACK("MSGID")))
167 Q:'DGLIEN
168 ;
169 I $G(DGACK("ACKCODE"))="AA" D
170 . D STOSTAT^DGPFHLL(26.17,DGLIEN,"A",.DGERR)
171 E D
172 . ;update transmission log status (REJECTED) and process error
173 . D STOSTAT^DGPFHLL(26.17,DGLIEN,"RJ",.DGERR)
174 . D PROCERR^DGPFHLU5(DGLIEN,.DGACK,.DGERR)
175 Q
176 ;
177RCVQRY(DGWRK,DGMIEN,DGHL) ;Receive QRY Message Types (QRY~R02)
178 ;
179 ; Input:
180 ; DGWRK - name of work global containing segments
181 ; DGMIEN - IEN of message entry in file #773
182 ; DGHL - HL environment array
183 ;
184 ; Output:
185 ; none
186 ;
187 N DGDFN
188 N DGDFNERR
189 N DGQRY
190 N DGQRYERR
191 N DGSEGERR
192 ;
193 D PARSQRY^DGPFHLQ3(DGWRK,.DGHL,.DGQRY,.DGSEGERR)
194 S DGDFN=$$GETDFN^DGPFUT2(DGQRY("ICN"),"DGDFNERR")
195 I DGDFN'>0,$G(DGDFNERR("DIERR",1))]"" D
196 . S DGQRYERR=DGDFNERR("DIERR",1)
197 D SNDORF^DGPFHLS(.DGQRY,DGMIEN,.DGHL,DGDFN,.DGSEGERR,.DGQRYERR)
198 Q
199 ;
200RCVORF(DGWRK,DGMIEN,DGHL) ;Receive ORF Message Types (ORF~R04)
201 ;
202 ; Input:
203 ; DGWRK - name of work global containing segments
204 ; DGMIEN - IEN of message entry in file #773
205 ; DGHL - HL environment array
206 ;
207 ; Output:
208 ; none
209 ;
210 N DGDFN ;pointer to PATIENT (#2) file
211 N DGLIEN ;HL7 query log IEN
212 N DGORF ;ORF data array root
213 N DGERR ;parser error array
214 N DGSTAT ;query log status
215 ;
216 S DGORF=$NA(^TMP("DGPF",$J))
217 K @DGORF
218 D PARSORF^DGPFHLQ4(DGWRK,.DGHL,DGORF,.DGERR)
219 S DGDFN=+$$GETDFN^MPIF001($G(@DGORF@("ICN")))
220 ;
221 ;successful query
222 I $G(@DGORF@("ACKCODE"))="AA" D
223 . S DGSTAT=$S(+$O(@DGORF@(0))>0:"A",1:"AN")
224 . ;
225 . ;REJECT when filer fails; otherwise mark event as COMPLETE
226 . I '$$STOORF(DGDFN,DGORF) D
227 . . S DGSTAT="RJ"
228 . . S DGERR($O(DGERR(""),-1)+1)=261120 ;Unable to file
229 . E D STOEVNT^DGPFHLL1(DGDFN,"C")
230 ;
231 ;failed query
232 I $G(@DGORF@("ACKCODE"))'="AA" S DGSTAT="RJ"
233 ;
234 ;find and update query log status
235 S DGLIEN=$$FNDLOG^DGPFHLL(26.19,$G(@DGORF@("MSGID")))
236 I DGLIEN D STOSTAT^DGPFHLL(26.19,DGLIEN,DGSTAT,.DGERR)
237 ;
238 ;purge PRF HL7 QUERY LOG when status is COMPLETE
239 I $$GETSTAT^DGPFHLL1(DGDFN)="C" D PRGQLOG^DGPFHLL($$FNDEVNT^DGPFHLL1(DGDFN))
240 ;
241 ;cleanup
242 K @DGORF
243 Q
244 ;
245STOORF(DGDFN,DGORF,DGERR) ;store ORF data
246 ;
247 ; Input:
248 ; DGDFN - pointer to patient in PATIENT (#2) file
249 ; DGORF - parsed ORF segments data array
250 ;
251 ; Output:
252 ; Function value - 1 on success; 0 on failure
253 ; DGERR - defined on failure
254 ;
255 N DGADT ;activity date ("ASSIGNDT")
256 N DGPFA ;assignment data array
257 N DGPFAH ;assignment history data array
258 N DGSET ;set id to represent a single PRF assignment
259 ;
260 ;
261 S DGSET=0
262 F S DGSET=$O(@DGORF@(DGSET)) Q:'DGSET D
263 . N DGPFA ;assignment data array
264 . ;
265 . S DGPFA("DFN")=DGDFN
266 . S DGPFA("FLAG")=$G(@DGORF@(DGSET,"FLAG"))
267 . Q:DGPFA("FLAG")']""
268 . ;
269 . ;prevent overwriting existing assignments
270 . Q:$$FNDASGN^DGPFAA(DGPFA("DFN"),DGPFA("FLAG"))
271 . ;
272 . ;init STATUS as a placeholder, $$STATUS^DGPFUT sets value in loop
273 . S DGPFA("STATUS")=""
274 . S DGPFA("OWNER")=$G(@DGORF@(DGSET,"OWNER"))
275 . S DGPFA("ORIGSITE")=$G(@DGORF@(DGSET,"ORIGSITE"))
276 . M DGPFA("NARR")=@DGORF@(DGSET,"NARR")
277 . S DGADT=0 ;each DGADT represents a single PRF history action
278 . F S DGADT=$O(@DGORF@(DGSET,DGADT)) Q:'DGADT D Q:$D(DGERR)
279 . . N DGPFAH ;assignment history data array
280 . . ;
281 . . S DGPFAH("ASSIGNDT")=DGADT
282 . . S DGPFAH("ACTION")=$G(@DGORF@(DGSET,DGADT,"ACTION"))
283 . . S DGPFAH("ENTERBY")=.5 ;POSTMASTER
284 . . S DGPFAH("APPRVBY")=.5 ;POSTMASTER
285 . . M DGPFAH("COMMENT")=@DGORF@(DGSET,DGADT,"COMMENT")
286 . . ;
287 . . ;calculate the assignment STATUS from the ACTION
288 . . S DGPFA("STATUS")=$$STATUS^DGPFUT(DGPFAH("ACTION"))
289 . . I $$STOALL^DGPFAA(.DGPFA,.DGPFAH,.DGERR)
290 Q '$D(DGERR)
Note: See TracBrowser for help on using the repository browser.