Changeset 623 for WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7R2.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7R2.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7R2.m
r613 r623 1 MHV7R2 ;WAS/GPM - HL7 RECEIVER FOR OMP^O09 ; [12/31/07 10:38am] 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 OMPO09 ;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. The 13 ; realtime request manager is called to handle all order messages. 14 ; This means the order will be processed and a response generated 15 ; immediately whether the message is synchronous or asynchronous. 16 ; 17 ; Input: 18 ; HL7 environment variables 19 ; 20 ; Output: 21 ; Processed query or negative acknowledgement 22 ; 23 N MSGROOT,REQ,XMT,ERR 24 S (REQ,XMT,ERR)="" 25 ; Inbound order messages are small enough to be held in a local. 26 ; The following lines commented out support use of global and are 27 ; left in case use a global becomes necessary. 28 ;S MSGROOT="^TMP(""MHV7"",$J)" 29 ;K @MSGROOT 30 S MSGROOT="MHV7MSG" 31 N MHV7MSG 32 D LOADXMT^MHV7U(.XMT) ;Load inbound message information 33 D LOG^MHVUL2("OMP-O09 RECEIVER","BEGIN","S","TRACE") 34 ; 35 D LOADMSG^MHV7U(MSGROOT) 36 D LOG^MHVUL2("LOAD",MSGROOT,"I","DEBUG") 37 ; 38 D PARSEMSG^MHV7U(MSGROOT,.HL) 39 D LOG^MHVUL2("PARSE",MSGROOT,"I","DEBUG") 40 ; 41 I '$$VALIDMSG(MSGROOT,.REQ,.XMT,.ERR) D Q 42 . D LOG^MHVUL2("MSG CHECK","INVALID^"_ERR,"S","ERROR") 43 . D XMIT^MHV7T(.REQ,.XMT,ERR,"",.HL) 44 D LOG^MHVUL2("MSG CHECK","VALID","S","TRACE") 45 ; 46 D REALTIME^MHVRQI(.REQ,.XMT,.HL) 47 ; 48 D LOG^MHVUL2("OMP-O09 RECEIVER","END","S","TRACE") 49 D RESET^MHVUL2 ;Clean up TMP used by logging 50 ;K @MSGROOT 51 ; 52 Q 53 ; 54 VALIDMSG(MSGROOT,REQ,XMT,ERR) ;Validate message 55 ; 56 ; OMP^O09 messages must contain PID, ORC, and RXE segments 57 ; 58 ; The following sequences are required 59 ; PID(3) - ICN/DFN 60 ; ORC(2) - Placer Order Number 61 ; RXE(1).4- Order Start Time 62 ; RXE(15) - Prescription Number 63 ; 64 ; The following sequences are optional 65 ; 66 ; ERR = segment^sequence^field^code^ACK type^error text 67 ; 68 ; Input: 69 ; MSGROOT - Root of array holding message 70 ; XMT - Transmission parameters 71 ; 72 ; Output: 73 ; REQ - Request Array 74 ; XMT - Transmission parameters 75 ; ERR - segment^sequence^field^code^ACK type^error text 76 ; 77 N MSH,PID,ORC,RXE,CNT,REQTYPE,I,ORDERCTL,PORDERN,ORDERQTY,GIVEID,GIVESYS,GIVEAMT,GIVEUNT,ORDERTM,RXNUM 78 K REQ,ERR 79 S ERR="" 80 ; 81 ; Set up message ID for responding to message. 82 ;--------------------------------------------- 83 S REQ("MID")=XMT("MID") ;Message ID 84 ; 85 ; Validate message is a well-formed OMP^O09 message 86 ;----------------------------------------------------------- 87 ; Must have MSH first followed by PID, then one or more ORC/RXE pairs 88 ; 89 I $G(@MSGROOT@(1,0))="MSH" M MSH=@MSGROOT@(1) 90 E S ERR="MSH^1^^100^AE^Missing MSH segment" Q 0 91 ; 92 I $G(@MSGROOT@(2,0))="PID" M PID=@MSGROOT@(2),REQ("PID")=PID 93 E S ERR="PID^1^^100^AE^Missing PID segment" Q 0 94 ; 95 S CNT=3 96 F Q:'$D(@MSGROOT@(CNT)) D Q:ERR'="" 97 . I $G(@MSGROOT@(CNT,0))="ORC" M ORC(CNT\2)=@MSGROOT@(CNT) 98 . E S ERR="ORC^1^^100^AE^Missing ORC segment" Q 99 . I $G(@MSGROOT@(CNT+1,0))="RXE" M RXE(CNT\2)=@MSGROOT@(CNT+1) 100 . E S ERR="RXE^1^^100^AE^Missing RXE segment" Q 101 . S CNT=CNT+2 102 . Q 103 Q:ERR'="" 0 104 ; 105 I '$D(ORC) S ERR="ORC^1^^100^AE^Missing ORC segment" Q 0 106 I '$D(RXE) S ERR="RXE^1^^100^AE^Missing RXE segment" Q 0 107 ; 108 ; 109 ; Validate required fields and refill request parameters 110 ;----------------------------------------------------------- 111 ; 112 I '$$VALIDPID^MHV7RUS(.PID,.REQ,.ERR) Q 0 113 ; 114 F I=1:1 Q:'$D(ORC(I)) D Q:ERR'="" 115 . S ORDERCTL=$G(ORC(I,1)) 116 . S PORDERN=$G(ORC(I,2)) 117 . I ORDERCTL="" S ERR="ORC^"_I_"^2^101^AE^Missing Order Control" Q 118 . I PORDERN="" S ERR="ORC^"_I_"^2^101^AE^Missing Placer Order#" Q 119 . ; 120 . S ORDERQTY=$G(RXE(I,1,1,1)) 121 . S ORDERTM=$G(RXE(I,1,1,4)) 122 . S GIVEID=$G(RXE(I,2,1,1)) 123 . S GIVESYS=$G(RXE(I,2,1,3)) 124 . S GIVEAMT=$G(RXE(I,3)) 125 . S GIVEUNT=$G(RXE(I,5)) 126 . S RXNUM=$G(RXE(I,15)) 127 . I ORDERQTY="" S ERR="RXE^"_I_"^1^101^AE^Missing Order Quantity" Q 128 . I ORDERTM="" S ERR="RXE^"_I_"^1^101^AE^Missing Order Start Time" Q 129 . I GIVEID="" S ERR="RXE^"_I_"^2^101^AE^Missign Give Code ID" Q 130 . I GIVESYS="" S ERR="RXE^"_I_"^2^101^AE^Missing Give Code System" Q 131 . I GIVEAMT="" S ERR="RXE^"_I_"^3^101^AE^Missing Give Amount" Q 132 . I GIVEUNT="" S ERR="RXE^"_I_"^5^101^AE^Missing Give Units" Q 133 . I RXNUM="" S ERR="RXE^"_I_"^15^101^AE^Missing Prescription#" Q 134 . I RXNUM'?1N.N0.1A S ERR="RXE^"_I_"^15^102^AE^Invalid Prescription#" Q 135 . S REQ("RX",I)=RXNUM_"^"_PORDERN_"^"_ORDERTM 136 . Q 137 Q:ERR'="" 0 138 ; 139 I '$$VALRTYPE^MHV7RU("RxRefill",.REQ,.ERR) S ERR="MSH^1^9^"_ERR Q 0 140 ; 141 Q 1 142 ; 1 MHV7R2 ;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 ; 5 OMPO09 ;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 ; 44 VALIDO09(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 ; 156 VALIDID(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 TracChangeset
for help on using the changeset viewer.
