source: WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7R1.m@ 613

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

initial load of WorldVistAEHR
File size: 6.0 KB
Line 
1MHV7R1 ;WAS/GPM - HL7 RECEIVER FOR QBP QUERIES ; [12/31/07 3:11pm]
2 ;;1.0;My HealtheVet;**1,2**;Aug 23, 2005;Build 22
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 Q
6 ;
7QBPQ13 ;Process QBP^Q13 messages from the MHV QBP-Q13 Subscriber protocol
8 ;
9QBPQ11 ;Process QBP^Q11 messages from the MHV QBP-Q11 Subscriber protocol
10 ;
11 ; This routine and subroutines assume that all VistA HL7 environment
12 ; variables are properly initialized and will produce a fatal error
13 ; if they are missing.
14 ;
15 ; The message will be checked to see if it is a valid query.
16 ; If not a negative acknowledgement will be sent. If the query is an
17 ; immediate mode or synchronous query, the realtime request manager
18 ; is called to handle the query. This means the query will be
19 ; processed and a response generated immediately.
20 ; In the future deferred mode queries may be filed in a database for
21 ; later processing, or transmission.
22 ;
23 ; Input:
24 ; HL7 environment variables
25 ;
26 ; Output:
27 ; Processed query or negative acknowledgement
28 ; If handled real-time the query response is generated
29 ;
30 N MSGROOT,QRY,XMT,ERR,RNAME
31 S (QRY,XMT,ERR)=""
32 ; Inbound query messages are small enough to be held in a local.
33 ; The following lines commented out support use of global and are
34 ; left in case use a global becomes necessary.
35 ;S MSGROOT="^TMP(""MHV7"",$J)"
36 ;K @MSGROOT
37 S MSGROOT="MHV7MSG"
38 N MHV7MSG
39 D LOADXMT^MHV7U(.XMT) ;Load inbound message information
40 ;
41 S RNAME=XMT("MESSAGE TYPE")_"-"_XMT("EVENT TYPE")_" RECEIVER"
42 D LOG^MHVUL2(RNAME,"BEGIN","S","TRACE")
43 ;
44 D LOADMSG^MHV7U(MSGROOT)
45 D LOG^MHVUL2("LOAD",MSGROOT,"I","DEBUG")
46 ;
47 D PARSEMSG^MHV7U(MSGROOT,.HL)
48 D LOG^MHVUL2("PARSE",MSGROOT,"I","DEBUG")
49 ;
50 I '$$VALIDMSG(MSGROOT,.QRY,.XMT,.ERR) D Q
51 . D LOG^MHVUL2("MSG CHECK","INVALID^"_ERR,"S","ERROR")
52 . D XMIT^MHV7T(.QRY,.XMT,ERR,"",.HL)
53 D LOG^MHVUL2("MSG CHECK","VALID","S","TRACE")
54 ;
55 ; Immediate Mode
56 ; Deferred mode queries are not supported at this time
57 D REALTIME^MHVRQI(.QRY,.XMT,.HL)
58 ;
59 D LOG^MHVUL2(RNAME,"END","S","TRACE")
60 D RESET^MHVUL2 ;Clean up TMP used by logging
61 ;K @MSGROOT
62 ;
63 Q
64 ;
65VALIDMSG(MSGROOT,QRY,XMT,ERR) ;Validate message
66 ;
67 ; Messages handled: QBP^Q13
68 ; QBP^Q11
69 ;
70 ; QBP query messages must contain PID, QPD and RCP segments
71 ; RXE segments are processed on Q13 prescription queries
72 ; Any additional segments are ignored
73 ;
74 ; The following sequences are required
75 ; PID(3) - Patient ID
76 ; PID(5)* - Patient Name
77 ; QPD(1)* - Message Query Name
78 ; QPD(2)* - Query Tag
79 ; QPD(3) - Request ID
80 ; QPD(4) - Subject Area
81 ; RCP(1) - Query Priority
82 ; * required by HL7 standard but not used by MHV
83 ;
84 ; The following sequences are optional
85 ; QPD(5) - From Date
86 ; QPD(6) - To Date
87 ; RCP(2) - Quantity Limited
88 ;
89 ; Input:
90 ; MSGROOT - Root of array holding message
91 ; XMT - Transmission parameters
92 ;
93 ; Output:
94 ; QRY - Query Array
95 ; XMT - Transmission parameters
96 ; ERR - segment^sequence^field^code^ACK type^error text
97 ;
98 N MSH,PID,RDF,RXE,QPD,RCP,REQID,REQTYPE,FROMDT,TODT,PRI,QTAG,QNAME,SEGTYPE,CNT,OCNT,RXNUM,QTY,UNIT
99 K QRY,ERR
100 S ERR=""
101 ;
102 ; Set up basics for responding to message.
103 ;-----------------------------------------
104 S QRY("MID")=XMT("MID") ;Message ID
105 S QRY("QPD")=""
106 ;
107 ; Validate message is a well-formed QBP query message.
108 ;-----------------------------------------------------------
109 ; Must have MSH first, followed by QPD,PID,RXE,RDF,RCP in any order
110 ; RXE is processed on Q13 prescriptions queries
111 ; RDF is not required
112 ; Any other segments are ignored.
113 ;
114 I $G(@MSGROOT@(1,0))="MSH" M MSH=@MSGROOT@(1)
115 E S ERR="MSH^1^^100^AE^Missing MSH segment" Q 0
116 ;
117 S CNT=2,OCNT=0
118 F Q:'$D(@MSGROOT@(CNT)) D S CNT=CNT+1
119 . S SEGTYPE=$G(@MSGROOT@(CNT,0))
120 . I SEGTYPE="PID" M PID=@MSGROOT@(CNT),QRY("PID")=PID Q
121 . I SEGTYPE="QPD" M QPD=@MSGROOT@(CNT),QRY("QPD")=QPD Q
122 . I SEGTYPE="RDF" M RDF=@MSGROOT@(CNT) Q
123 . I SEGTYPE="RCP" M RCP=@MSGROOT@(CNT) Q
124 . I SEGTYPE="RXE" S OCNT=OCNT+1 M RXE(OCNT)=@MSGROOT@(CNT) Q
125 . Q
126 ;
127 I '$D(PID) S ERR="PID^1^^100^AE^Missing PID segment" Q 0
128 I '$D(QPD) S ERR="QPD^1^^100^AE^Missing QPD segment" Q 0
129 I '$D(RCP) S ERR="RCP^1^^100^AE^Missing RCP segment" Q 0
130 ;
131 ; Validate required fields and query parameters
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 S PRI=$G(RCP(1)) ;Query Priority
139 S QTY=$G(RCP(2,1,1)) ;Quantity Limited
140 S UNIT=$G(RCP(2,1,2)) ;Quantity units
141 ;
142 I '$D(QPD(1)) S ERR="QPD^1^1^101^AE^Missing Message Query Name" Q 0
143 M QNAME=QPD(1) ;Message Query Name
144 ;
145 I QTAG="" S ERR="QPD^1^2^101^AE^Missing Query Tag" Q 0
146 ;
147 I REQID="" S ERR="QPD^1^3^101^AE^Missing Request ID" Q 0
148 S QRY("REQID")=REQID
149 ;
150 I REQTYPE="" S ERR="QPD^1^4^101^AE^Missing Request Type" Q 0
151 I '$$VALRTYPE^MHV7RU(REQTYPE,.QRY,.ERR) S ERR="QPD^1^4^"_ERR Q 0
152 ;
153 I '$$VALIDDT^MHV7RU(.FROMDT) S ERR="QPD^1^5^102^AE^Invalid From Date" Q 0
154 S QRY("FROM")=FROMDT
155 I '$$VALIDDT^MHV7RU(.TODT) S ERR="QPD^1^6^102^AE^Invalid To Date" Q 0
156 I TODT'="",TODT<FROMDT S ERR="QPD^1^6^102^AE^To Date precedes From Date" Q 0
157 S QRY("TO")=TODT
158 ;
159 I '$$VALIDPID^MHV7RUS(.PID,.QRY,.ERR) Q 0
160 ;
161 I PRI="" S ERR="RCP^1^1^101^AE^Missing Query Priority" Q 0
162 I ",D,I,"'[(","_PRI_",") S ERR="RCP^1^1^102^AE^Invalid Query Priority" Q 0
163 S QRY("PRI")=PRI
164 ;
165 I QTY'?0.N S ERR="RCP^1^2^102^AE^Invalid Quantity" Q 0
166 S QRY("QTY")=+QTY
167 S XMT("MAX SIZE")=+QTY
168 ;
169 I QTY,UNIT'="CH" S ERR="RCP^1^2^102^AE^Invalid Units" Q 0
170 ;
171 ; Setup prescription list (if passed)
172 ;------------------------------------
173 F CNT=1:1 Q:'$D(RXE(CNT)) D Q:ERR'=""
174 . S RXNUM=$G(RXE(CNT,15))
175 . I RXNUM="" S ERR="RXE^"_CNT_"^15^101^AE^Missing Prescription#" Q
176 . I RXNUM'?1.N0.A S ERR="RXE^"_CNT_"^15^102^AE^Invalid Prescription#" Q
177 . S QRY("RXLIST",RXNUM)=""
178 . Q
179 Q:ERR'="" 0
180 ;
181 Q 1
182 ;
Note: See TracBrowser for help on using the repository browser.