source: FOIAVistA/trunk/r/MY_HEALTHEVET-MHV/MHV7R2.m@ 808

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

initial load of FOIAVistA 6/30/08 version
File size: 6.8 KB
Line 
1MHV7R2 ;WAS/GPM - HL7 RECEIVER FOR OMP^O09 ; [5/24/06 10:20am]
2 ;;1.0;My HealtheVet;**1**;Aug 23, 2005
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5OMPO09 ;Process OMP^O09 messages from the MHV OMP^O09 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 OMP^O09 order
12 ; message. If not, a negative acknowledgement will be sent. If the ; order message is real time or synchronous, the realtime request
13 ; manager is called to handle it.
14 ;
15 ; Input:
16 ; HL7 environment variables
17 ;
18 ; Output:
19 ; Processed query or negative acknowledgement
20 ;
21 N MSGROOT,REQ,XMT,ERR
22 S (REQ,XMT,ERR)=""
23 S MSGROOT="^TMP(""MHV7"",$J)"
24 D LOG^MHV7U("OMP-O09 RECEIVER","","S",1)
25 ;
26 D LOADMSG^MHV7U(MSGROOT)
27 D LOG^MHV7U("LOAD",MSGROOT,"I",0)
28 ;
29 D PARSEMSG^MHV7U(MSGROOT,.HL)
30 ;D LOG^MHV7U("PARSE",MSGROOT,"I",0)
31 ;
32 I '$$VALIDO09(MSGROOT,.REQ,.XMT,.ERR) D Q
33 . D LOG^MHV7U("MSG CHECK","INVALID^"_ERR,"S",0)
34 . D XMIT^MHV7T(.REQ,.XMT,ERR,"",.HL)
35 D LOG^MHV7U("MSG CHECK","VALID","S",0)
36 ;
37 ; Immediate Mode
38 ; Only real time synchronous calls are supported at this time.
39 I REQ("PRI")="I" D REALTIME^MHVRQI(.REQ,.XMT,.HL)
40 K ^TMP("MHV7LOG",$J)
41 ;
42 Q
43 ;
44VALIDO09(MSGROOT,REQ,XMT,ERR) ;Parse and Validate message
45 ;
46 ; OMP^O09 messages must contain PID, ORC, and RXE segments
47 ; The following sequences are required
48 ; PID(3) - ICN/DFN
49 ; ORC(2) - Placer Order Number
50 ; RXE(1).4- Order Start Time
51 ; RXE(15) - Prescription Number
52 ; The following sequences are optional
53 ;
54 ; ERR = segment^sequence^field^code^ACK type^error text
55 ;
56 N MSH,PID,ORC,RXE,CNT,ICN,SSN,REQTYPE,DFN,PRI,REQTIEN,REQT0,TYPE,ID,I,ORDERCTL,PORDERN,ORDERQTY,GIVEID,GIVESYS,GIVEAMT,GIVEUNT,ORDERTM,RXNUM,FAMILY,GIVEN,MIDDLE,SUFFIX
57 S ERR=""
58 K REQ,XMT
59 ;
60 ;Set response control defaults
61 S XMT("PROTOCOL")="MHV ORP-O10 Event Driver" ;Response protocol
62 S XMT("BUILDER")="ORPO10^MHV7B2" ;Response builder
63 S XMT("MODE")="D" ;Response mode
64 I $G(HL("APAT"))="" S XMT("MODE")="I" ;Immediate mode
65 S XMT("HLMTIENS")=HLMTIENS ;Message IEN
66 S REQ("MID")="" ;Message ID
67 ;
68 ;Validate message is a well-formed OMP^O09 message
69 ;Must have MSH first followed by PID, then one or more ORC/RXE pairs
70 I $G(@MSGROOT@(1,0))="MSH" M MSH=@MSGROOT@(1) S REQ("MID")=$G(MSH(9))
71 E S ERR="MSH^1^^100^AE^Missing MSH segment" Q 0
72 I $G(@MSGROOT@(2,0))="PID" M PID=@MSGROOT@(2),REQ("PID")=PID
73 E S ERR="PID^1^^100^AE^Missing PID segment" Q 0
74 S CNT=3
75 F Q:'$D(@MSGROOT@(CNT)) D Q:ERR'=""
76 . I $G(@MSGROOT@(CNT,0))="ORC" M ORC(CNT\2)=@MSGROOT@(CNT)
77 . E S ERR="ORC^1^^100^AE^Missing ORC segment" Q
78 . I $G(@MSGROOT@(CNT+1,0))="RXE" M RXE(CNT\2)=@MSGROOT@(CNT+1)
79 . E S ERR="RXE^1^^100^AE^Missing RXE segment" Q
80 . S CNT=CNT+2
81 . Q
82 Q:ERR'="" 0
83 I '$D(ORC) S ERR="ORC^1^^100^AE^Missing ORC segment" Q 0
84 I '$D(RXE) S ERR="RXE^1^^100^AE^Missing RXE segment" Q 0
85 ;
86 ;
87 ;Validate required fields and refill request parameters
88 ;
89 S ICN="",DFN="",SSN=""
90 F I=1:1:3 Q:'$D(PID(3,I)) D Q:ERR'=""
91 . S ID=$G(PID(3,I,1))
92 . S TYPE=$G(PID(3,I,5))
93 . I ID="" S ERR="PID^1^3^101^AE^Missing Patient ID" Q
94 . I TYPE="" S ERR="PID^1^3^101^AE^Missing Patient ID Type" Q
95 . I TYPE="NI" S ICN=ID
96 . I TYPE="PI" S DFN=ID
97 . I TYPE="SS" S SSN=ID
98 . Q
99 Q:ERR'="" 0
100 ;
101 S FAMILY=$G(PID(5,1,1))
102 S GIVEN=$G(PID(5,1,2))
103 S MIDDLE=$G(PID(5,1,3))
104 S SUFFIX=$G(PID(5,1,4))
105 ;
106 I '$$VALIDID(.ICN,.DFN,.SSN,.ERR) S ERR="PID^1^3^"_ERR Q 0
107 ;
108 ; *** May need to add validation of name - compare against system
109 ;I FAMILY="" S ERR="PID^1^5^101^AE^Missing Patient Family Name" Q 0
110 ;I GIVEN="" S ERR="PID^1^5^101^AE^Missing Patient Given Name" Q 0
111 ;
112 F I=1:1 Q:'$D(ORC(I)) D Q:ERR'=""
113 . S ORDERCTL=$G(ORC(I,1))
114 . S PORDERN=$G(ORC(I,2))
115 . I ORDERCTL="" S ERR="ORC^"_I_"^2^101^AE^Missing Order Control" Q
116 . I PORDERN="" S ERR="ORC^"_I_"^2^101^AE^Missing Placer Order#" Q
117 . ;
118 . S ORDERQTY=$G(RXE(I,1,1,1))
119 . S ORDERTM=$G(RXE(I,1,1,4))
120 . S GIVEID=$G(RXE(I,2,1,1))
121 . S GIVESYS=$G(RXE(I,2,1,3))
122 . S GIVEAMT=$G(RXE(I,3))
123 . S GIVEUNT=$G(RXE(I,5))
124 . S RXNUM=$G(RXE(I,15))
125 . I ORDERQTY="" S ERR="RXE^"_I_"^1^101^AE^Missing Order Quantity" Q
126 . I ORDERTM="" S ERR="RXE^"_I_"^1^101^AE^Missing Order Start Time" Q
127 . I GIVEID="" S ERR="RXE^"_I_"^2^101^AE^Missign Give Code ID" Q
128 . I GIVESYS="" S ERR="RXE^"_I_"^2^101^AE^Missing Give Code System" Q
129 . I GIVEAMT="" S ERR="RXE^"_I_"^3^101^AE^Missing Give Amount" Q
130 . I GIVEUNT="" S ERR="RXE^"_I_"^5^101^AE^Missing Give Units" Q
131 . I RXNUM="" S ERR="RXE^"_I_"^15^101^AE^Missing Prescription#" Q
132 . I RXNUM'?1N.N0.1A S ERR="RXE^"_I_"^15^102^AE^Invalid Prescription#" Q
133 . S REQ("RX",I)=RXNUM_"^"_PORDERN_"^"_ORDERTM
134 . Q
135 Q:ERR'="" 0
136 ;
137 S PRI=XMT("MODE")
138 S REQTYPE="RxRefill"
139 S REQTIEN=$O(^MHV(2275.3,"D",REQTYPE,0))
140 I 'REQTIEN S ERR="MSH^1^9^103^AE^Request Type Not Found" Q 0
141 S REQT0=$G(^MHV(2275.3,REQTIEN,0))
142 S REQTYPE=$P(REQT0,"^",2)
143 ;
144 S REQ("ICN")=ICN ;ICN
145 S REQ("DFN")=DFN ;DFN
146 S REQ("SSN")=SSN ;SSN
147 S REQ("TYPE")=REQTYPE ;Request Data Type
148 S REQ("PRI")=PRI ;Priority
149 ;
150 S REQ("BLOCKED")=$P(REQT0,"^",3)
151 S REQ("REALTIME")=$P(REQT0,"^",4)
152 S REQ("EXECUTE")=$TR($P(REQT0,"^",5),"~","^")
153 ;
154 Q 1
155 ;
156VALIDID(ICN,DFN,SSN,ERR) ;Validate patient identifiers
157 ; Will accept ICN, SSN, or DFN, but must have at least one.
158 ; Only validate one, in order of preference: ICN, SSN, DFN.
159 ;
160 ; Integration Agreements:
161 ; 2701 : $$GETDFN^MPIF001, $$GETICN^MPIF001
162 ; 10035 : Direct reference of ^DPT(DFN,0);9
163 ; and reference of ^DPT("SSN") x-ref
164 ;
165 N XSSN,XDFN
166 S ERR=""
167 I ICN="",SSN="",DFN="" S ERR="101^AE^Missing Patient ID" Q 0
168 ;I ICN="" S ERR="101^AE^Missing ICN" Q 0
169 ;
170 I ICN'="" D Q:ERR'="" 0 Q 1
171 . S ICN=$P(ICN,"V")
172 . I ICN'?9.10N S ERR="102^AE^Invalid ICN" Q
173 . S XDFN=$$GETDFN^MPIF001(ICN)
174 . I XDFN<1 S ERR="204^AR^Patient Not Found" Q
175 . S XSSN=$P($G(^DPT(XDFN,0)),"^",9)
176 . I SSN'="" D Q:ERR'=""
177 .. I SSN'?9N S ERR="102^AE^Invalid SSN" Q
178 .. I SSN'=XSSN S ERR="204^AE^Patient SSN Mismatch" Q
179 . I DFN'="",DFN'=XDFN S ERR="204^AE^Patient DFN Mismatch" Q
180 . S DFN=XDFN,SSN=XSSN
181 . Q
182 ;
183 I SSN'="" D Q:ERR'="" 0 Q 1
184 . I SSN'?9N S ERR="102^AE^Invalid SSN" Q
185 . S XDFN=$O(^DPT("SSN",SSN,""))
186 . I XDFN<1 S ERR="204^AR^Patient Not Found" Q
187 . S ICN=+$$GETICN^MPIF001(DFN)
188 . I ICN<1 S ICN=""
189 . I DFN'="",DFN'=XDFN S ERR="204^AE^Patient DFN Mismatch" Q
190 . S DFN=XDFN
191 . Q
192 ;
193 I DFN'="" D Q:ERR'="" 0 Q 1
194 . I DFN'?1N.N S ERR="102^AE^Invalid DFN" Q
195 . I DFN<1 S ERR="102^AE^Invalid DFN" Q
196 . I '$D(^DPT(DFN,0)) S ERR="204^AR^Patient Not Found" Q
197 . S ICN=+$$GETICN^MPIF001(DFN)
198 . I ICN<1 S ICN=""
199 . S SSN=$P($G(^DPT(DFN,0)),"^",9)
200 . Q
201 ;
202 S ERR="101^AE^Missing Patient ID" Q 0
203 ;
Note: See TracBrowser for help on using the repository browser.