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