| 1 | MHV7R1 ;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 | ;
|
|---|
| 5 | QBPQ13 ;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 | ;
|
|---|
| 52 | VALIDQ13(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 | ;
|
|---|
