- 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 Feb 18, 2025@23:42:04 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 ;