source: FOIAVistA/trunk/r/MY_HEALTHEVET-MHV/MHV7R1.m@ 635

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

initial load of FOIAVistA 6/30/08 version
File size: 6.4 KB
Line 
1MHV7R1 ;WAS/GPM - HL7 RECEIVER FOR QBP^Q13 ; [5/24/06 10:19am]
2 ;;1.0;My HealtheVet;**1**;Aug 23, 2005
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5QBPQ13 ;Process QBP^Q13 messages from the MHV QBP-Q13 Subscriber protocol
6 ;
7 ; This routine and subroutines assume that all VistA HL7 environment
8 ; variables are properly initialized and will produce a fatal error
9 ; if they are missing.
10 ;
11 ; The message will be checked to see if it is a valid QBP^Q13 query.
12 ; If not a negative acknowledgement will be sent. If the query is an
13 ; immediate mode or synchronous query, the realtime request manager
14 ; is called to handle the query.
15 ; In the future deferred mode queries may be filed in a database for
16 ; later processing, or transmission.
17 ;
18 ; Integration Agreements:
19 ; 10103 : $$HL7TFM^XLFDT
20 ;
21 ; Input:
22 ; HL7 environment variables
23 ;
24 ; Output:
25 ; Processed query or negative acknowledgement
26 ;
27 N MSGROOT,QRY,XMT,ERR
28 S (QRY,XMT,ERR)=""
29 ;S MSGROOT="^TMP(""MHV7"",$J)"
30 S MSGROOT="MHV7MSG"
31 N MHV7MSG
32 D LOG^MHV7U("QBP-Q13 RECEIVER","","S",1)
33 ;
34 D LOADMSG^MHV7U(MSGROOT)
35 D LOG^MHV7U("LOAD",MSGROOT,"I",0)
36 ;
37 D PARSEMSG^MHV7U(MSGROOT,.HL)
38 ;D LOG^MHV7U("PARSE",MSGROOT,"I",0)
39 ;
40 I '$$VALIDQ13(MSGROOT,.QRY,.XMT,.ERR) D Q
41 . D LOG^MHV7U("MSG CHECK","INVALID^"_ERR,"S",0)
42 . D XMIT^MHV7T(.QRY,.XMT,ERR,"",.HL)
43 D LOG^MHV7U("MSG CHECK","VALID","S",0)
44 ;
45 ; Immediate Mode
46 ; Only real time synchronous calls are supported at this time.
47 I QRY("PRI")="I" D REALTIME^MHVRQI(.QRY,.XMT,.HL)
48 K ^TMP("MHV7LOG",$J)
49 ;
50 Q
51 ;
52VALIDQ13(MSG,QRY,XMT,ERR) ;Parse and Validate message
53 ;
54 ; QBP^Q13 messages must contain QPD and RCP segments
55 ; RDF segments are optional but not processed
56 ; The following sequences are required
57 ; PID(3) - Patient ID
58 ; QPD(3) - Request ID
59 ; QPD(4) - Subject Area
60 ; RCP(1) - priority
61 ; The following sequences are optional
62 ; QPD(5) - From Date
63 ; QPD(6) - To Date
64 ; QPD(7) - ICN
65 ; QPD(8) - DFN
66 ;
67 ; ERR = segment^sequence^field^code^ACK type^error text
68 ;
69 N MSH,PID,RDF,RXE,QPD,RCP,REQID,ICN,REQTYPE,FROMDT,TODT,DFN,PRI,REQTIEN,REQT0,QTAG,QNAME,SEGTYPE,CNT,SSN,FAMILY,GIVEN,MIDDLE,SUFFIX,SEGTYPE,CNT,OCNT,RXNUM,I,ID,TYPE
70 S ERR=""
71 K QRY,XMT
72 ;
73 ;Set response control defaults
74 S XMT("PROTOCOL")="MHV RTB-K13 Event Driver" ;Response protocol
75 S XMT("BUILDER")="RTBK13^MHV7B1" ;Response builder
76 S XMT("MODE")="D" ;Response mode
77 I $G(HL("APAT"))="" S XMT("MODE")="I" ;Immediate mode
78 S XMT("HLMTIENS")=HLMTIENS ;Message IEN
79 S QRY("MID")="" ;Message ID
80 S QRY("QPD")="" ;QPD segment
81 ;
82 ;
83 ;Validate message is a well formed QBP^Q13 message
84 ;
85 ;Must have MSH first, followed by QPD,PID,RXE,RDF,RCP in any order
86 ;RDF is not required, any other segments are ignored
87 ;
88 I $G(@MSGROOT@(1,0))="MSH" M MSH=@MSGROOT@(1) S QRY("MID")=$G(MSH(9))
89 E S ERR="MSH^1^^100^AE^Missing MSH segment" Q 0
90 S CNT=2,OCNT=0
91 F Q:'$D(@MSGROOT@(CNT)) D S CNT=CNT+1
92 . S SEGTYPE=$G(@MSGROOT@(CNT,0))
93 . I SEGTYPE="PID" M PID=@MSGROOT@(CNT),QRY("PID")=PID Q
94 . I SEGTYPE="QPD" M QPD=@MSGROOT@(CNT),QRY("QPD")=QPD Q
95 . I SEGTYPE="RDF" M RDF=@MSGROOT@(CNT) Q
96 . I SEGTYPE="RCP" M RCP=@MSGROOT@(CNT) Q
97 . I SEGTYPE="RXE" S OCNT=OCNT+1 M RXE(OCNT)=@MSGROOT@(CNT) Q
98 . Q
99 ;
100 I '$D(PID) S ERR="PID^1^^100^AE^Missing PID segment" Q 0
101 I '$D(QPD) S ERR="QPD^1^^100^AE^Missing QPD segment" Q 0
102 I '$D(RCP) S ERR="RCP^1^^100^AE^Missing RCP segment" Q 0
103 ;
104 ;
105 ;Validate required fields and query parameters
106 ;
107 S ICN="",DFN="",SSN=""
108 F I=1:1:3 Q:'$D(PID(3,I)) D Q:ERR'=""
109 . S ID=$G(PID(3,I,1))
110 . S TYPE=$G(PID(3,I,5))
111 . I ID="" S ERR="PID^1^3^101^AE^Missing Patient ID" Q
112 . I TYPE="" S ERR="PID^1^3^101^AE^Missing Patient ID Type" Q
113 . I TYPE="NI" S ICN=ID
114 . I TYPE="PI" S DFN=ID
115 . I TYPE="SS" S SSN=ID
116 . Q
117 Q:ERR'="" 0
118 ;
119 S FAMILY=$G(PID(5,1,1))
120 S GIVEN=$G(PID(5,1,2))
121 S MIDDLE=$G(PID(5,1,3))
122 S SUFFIX=$G(PID(5,1,4))
123 ;
124 ; ID is validated from PID only,
125 ; May want to add fallback to use ID supplied in QPD
126 I '$$VALIDID^MHV7R2(.ICN,.DFN,.SSN,.ERR) S ERR="PID^1^3^"_ERR Q 0
127 ;
128 ; *** May need to add validation of name - compare against system
129 ;I FAMILY="" S ERR="PID^1^5^101^AE^Missing Patient Family Name" Q 0
130 ;I GIVEN="" S ERR="PID^1^5^101^AE^Missing Patient Given Name" Q 0
131 ;
132 ;
133 S QTAG=$G(QPD(2)) ;Query Tag
134 S REQID=$G(QPD(3)) ;Request ID
135 S REQTYPE=$G(QPD(4)) ;Request Type
136 S FROMDT=$G(QPD(5)) ;From Date
137 S TODT=$G(QPD(6)) ;To Date
138 ; Do not use ICN or DFN from QPD, get from PID
139 ;I ICN="" S ICN=$G(QPD(7)) ;ICN
140 ;I DFN="" S DFN=$G(QPD(8)) ;DFN
141 S PRI=$G(RCP(1)) ;Query Priority
142 ;
143 I '$D(QPD(1)) S ERR="QPD^1^1^101^AE^Missing Message Query Name" Q 0
144 M QNAME=QPD(1) ;Message Query Name
145 ;
146 I QTAG="" S ERR="QPD^1^2^101^AE^Missing Query Tag" Q 0
147 ;
148 I REQID="" S ERR="QPD^1^3^101^AE^Missing Request ID" Q 0
149 ;
150 I REQTYPE="" S ERR="QPD^1^4^101^AE^Missing Request Type" Q 0
151 S REQTIEN=$O(^MHV(2275.3,"D",REQTYPE,0))
152 I 'REQTIEN S ERR="QPD^1^4^103^AE^Request Type Not Found" Q 0
153 S REQT0=$G(^MHV(2275.3,REQTIEN,0))
154 S REQTYPE=$P(REQT0,"^",2)
155 ;
156 I FROMDT'="" D Q:ERR'="" 0
157 . I FROMDT'?8.16N S ERR="QPD^1^5^102^AE^Invalid From Date" Q
158 . ;***Check into Time Zone issue between MHV server and site
159 . S FROMDT=$$HL7TFM^XLFDT(FROMDT)\1
160 . I FROMDT'?7N S ERR="QPD^1^5^102^AE^Invalid From Date" Q
161 . Q
162 ;
163 I TODT'="" D Q:ERR'="" 0
164 . I TODT'?8.16N S ERR="QPD^1^6^102^AE^Invalid To Date" Q
165 . ;***Check into Time Zone issue between MHV server and site
166 . S TODT=$$HL7TFM^XLFDT(TODT)\1
167 . I TODT'?7N S ERR="QPD^1^6^102^AE^Invalid To Date" Q
168 . Q
169 ;
170 I TODT'="",TODT<FROMDT S ERR="QPD^1^6^102^AE^To Date precedes From Date" Q 0
171 ;
172 I PRI="" S ERR="RCP^1^1^101^AE^Missing Query Priority" Q 0
173 I "D|I"'[PRI S ERR="RCP^1^1^102^AE^Invalid Query Priority" Q 0
174 ;
175 F CNT=1:1 Q:'$D(RXE(CNT)) D
176 . S RXNUM=$G(RXE(CNT,15))
177 . Q:RXNUM<1
178 . S QRY("RXLIST",RXNUM)=""
179 . Q
180 ;
181 S QRY("REQID")=REQID ;Request ID
182 S QRY("ICN")=ICN ;ICN
183 S QRY("TYPE")=REQTYPE ;Request Data Type
184 S QRY("FROM")=FROMDT ;From Date
185 S QRY("TO")=TODT ;To Date
186 S QRY("DFN")=DFN ;DFN
187 S QRY("SSN")=SSN ;SSN
188 S QRY("PRI")=PRI ;Priority
189 ;
190 S QRY("BLOCKED")=$P(REQT0,"^",3)
191 S QRY("REALTIME")=$P(REQT0,"^",4)
192 S QRY("EXECUTE")=$TR($P(REQT0,"^",5),"~","^")
193 ;
194 Q 1
195 ;
Note: See TracBrowser for help on using the repository browser.