MHV7R4 ;WAS/GPM - HL7 RECEIVER FOR SECURE MESSAGING QRY^A19 ; [3/23/08 9:32pm]
;;1.0;My HealtheVet;**5**;Aug 23, 2005;Build 24
;;Per VHA Directive 2004-038, this routine should not be modified.
;
Q
;
QRYA19 ;Process QRY^A19 messages from the MHVSM QRY-A19 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="SM "_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: QRY^A19 - Demographics
;
; Old style query messages must contain QRD and QRF segments.
; Any additional segments are ignored.
;
; The following sequences are required
; QRD(1)* - Query Date/Time
; QRD(2)* - Query Format Code
; QRD(3) - Query Priority
; QRD(4) - Query ID
; QRD(8) - Who Subject Filter
; QRD(9)* - What Subject Filter
; QRD(10) - What Dept. Data Code
; QRF(1)* - Where Subject Filter
; * required by HL7 standard but not used by MHV
; Name fields in Who Subject Filter also not used
;
; The following sequences are optional
; QRD(7) - Quantity Limited Request
; QRF(2) - When Data Start Date/Time
; QRF(3) - When Data End Date/Time
;
; 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,QRD,QRF,ICN,DFN,SSN,I,ID,REQTYPE,PRI,REQID,TYPE,FROMDT,TODT,SEGTYPE,CNT,FAMILY,GIVEN,MIDDLE,SUFFIX,FORMAT,WHAT,WHERE,OCNT,QTY,QDATE,UNIT
K QRY,ERR
S ERR=""
;
; Set up basics for responding to message.
;-----------------------------------------
S QRY("MID")=XMT("MID") ;Message ID
S QRY("QRD")=""
S QRY("QRF")=""
;
; Validate message is a well-formed old style query message.
;-----------------------------------------------------------
; Must have MSH first followed by QRD, and QRF in any order.
; 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="QRD" M QRD=@MSGROOT@(CNT),QRY("QRD")=QRD Q
. I SEGTYPE="QRF" M QRF=@MSGROOT@(CNT),QRY("QRF")=QRF Q
. Q
;
I '$D(QRD) S ERR="QRD^1^^100^AE^Missing QRD segment" Q 0
I '$D(QRF) S ERR="QRF^1^^100^AE^Missing QRF segment" Q 0
;
; Validate required fields and query parameters
;------------------------------------------------------
S QDATE=$G(QRD(1)) ;Query Date/Time
S FORMAT=$G(QRD(2)) ;Query Format Code
S PRI=$G(QRD(3)) ;Query Priority
S REQID=$G(QRD(4)) ;Query ID - Request ID
S QTY=$G(QRD(7,1,1)) ;Quantity Limited Request
S UNIT=$G(QRD(7,1,2)) ;Quantity Units
S WHAT=$G(QRD(9,1,1)) ;What Subject Filter
S REQTYPE=$G(QRD(10)) ;What Dept. Data Code - Request Type
S WHERE=$G(QRF(1)) ;Where Subject Filter
S FROMDT=$G(QRF(2)) ;When Data Start Date/Time - From Date
S TODT=$G(QRF(3)) ;When Data End Date/Time - To Date
;
I QDATE="" S ERR="QRD^1^1^101^AE^Missing Query Date/Time" Q 0
I '$$VALIDDT^MHV7RU(.QDATE) S ERR="QRD^1^1^102^AE^Invalid Query Date/Time" Q 0
;
I FORMAT="" S ERR="QRD^1^2^101^AE^Missing Query Format Code" Q 0
I FORMAT'="R" S ERR="QRD^1^2^102^AE^Invalid Query Format Code" Q 0
;
I PRI="" S ERR="QRD^1^3^101^AE^Missing Query Priority" Q 0
I ",D,I,"'[(","_PRI_",") S ERR="QRD^1^3^102^AE^Invalid Query Priority" Q 0
S QRY("PRI")=PRI
;
I REQID="" S ERR="QRD^1^4^101^AE^Missing Request ID" Q 0
S QRY("REQID")=REQID
;
I QTY'?0.N S ERR="QRD^1^7^102^AE^Invalid Quantity" Q 0
S QRY("QTY")=+QTY
S XMT("MAX SIZE")=+QTY
;
I QTY,UNIT'="CH" S ERR="QRD^1^7^102^AE^Invalid Units" Q 0
;
I WHAT="" S ERR="QRD^1^9^101^AE^Missing What Subject Filter" Q 0
;
I REQTYPE="" S ERR="QRD^1^10^101^AE^Missing Request Type" Q 0
I '$$VALRTYPE^MHV7RU(REQTYPE,.QRY,.ERR) S ERR="QRD^1^10^"_ERR Q 0
;
I '$$VALIDWHO^MHV7RUS(.QRD,.QRY,.ERR) Q 0
;
I WHERE="" S ERR="QRF^1^1^101^AE^Missing Where Subject Filter" Q 0
;
I '$$VALIDDT^MHV7RU(.FROMDT) S ERR="QRF^1^2^102^AE^Invalid From Date" Q 0
S QRY("FROM")=FROMDT
I '$$VALIDDT^MHV7RU(.TODT) S ERR="QRF^1^3^102^AE^Invalid To Date" Q 0
I TODT'="",TODT<FROMDT S ERR="QRF^1^3^102^AE^To Date precedes From Date" Q 0
S QRY("TO")=TODT
;
; Get HL7 delimiters to be used in the response message
; Some extractors call APIs that require delimiters to be passed
S QRY("DELIM")=XMT("DELIM")
I XMT("MODE")="A" S QRY("DELIM")=$$DELIM^MHV7U(XMT("PROTOCOL"))
;
Q 1
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMHV7R4 6593 printed Apr 09, 2024@21:18:03 Page 2
MHV7R4 ;WAS/GPM - HL7 RECEIVER FOR SECURE MESSAGING QRY^A19 ; [3/23/08 9:32pm]
+1 ;;1.0;My HealtheVet;**5**;Aug 23, 2005;Build 24
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
QRYA19 ;Process QRY^A19 messages from the MHVSM QRY-A19 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="SM "_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: QRY^A19 - Demographics
+3 ;
+4 ; Old style query messages must contain QRD and QRF segments.
+5 ; Any additional segments are ignored.
+6 ;
+7 ; The following sequences are required
+8 ; QRD(1)* - Query Date/Time
+9 ; QRD(2)* - Query Format Code
+10 ; QRD(3) - Query Priority
+11 ; QRD(4) - Query ID
+12 ; QRD(8) - Who Subject Filter
+13 ; QRD(9)* - What Subject Filter
+14 ; QRD(10) - What Dept. Data Code
+15 ; QRF(1)* - Where Subject Filter
+16 ; * required by HL7 standard but not used by MHV
+17 ; Name fields in Who Subject Filter also not used
+18 ;
+19 ; The following sequences are optional
+20 ; QRD(7) - Quantity Limited Request
+21 ; QRF(2) - When Data Start Date/Time
+22 ; QRF(3) - When Data End Date/Time
+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,QRD,QRF,ICN,DFN,SSN,I,ID,REQTYPE,PRI,REQID,TYPE,FROMDT,TODT,SEGTYPE,CNT,FAMILY,GIVEN,MIDDLE,SUFFIX,FORMAT,WHAT,WHERE,OCNT,QTY,QDATE,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("QRD")=""
+41 SET QRY("QRF")=""
+42 ;
+43 ; Validate message is a well-formed old style query message.
+44 ;-----------------------------------------------------------
+45 ; Must have MSH first followed by QRD, and QRF in any order.
+46 ; Any other segments are ignored.
+47 ;
+48 IF $GET(@MSGROOT@(1,0))="MSH"
MERGE MSH=@MSGROOT@(1)
+49 IF '$TEST
SET ERR="MSH^1^^100^AE^Missing MSH segment"
QUIT 0
+50 ;
+51 SET CNT=2
SET OCNT=0
+52 FOR
if '$DATA(@MSGROOT@(CNT))
QUIT
Begin DoDot:1
+53 SET SEGTYPE=$GET(@MSGROOT@(CNT,0))
+54 IF SEGTYPE="QRD"
MERGE QRD=@MSGROOT@(CNT),QRY("QRD")=QRD
QUIT
+55 IF SEGTYPE="QRF"
MERGE QRF=@MSGROOT@(CNT),QRY("QRF")=QRF
QUIT
+56 QUIT
End DoDot:1
SET CNT=CNT+1
+57 ;
+58 IF '$DATA(QRD)
SET ERR="QRD^1^^100^AE^Missing QRD segment"
QUIT 0
+59 IF '$DATA(QRF)
SET ERR="QRF^1^^100^AE^Missing QRF segment"
QUIT 0
+60 ;
+61 ; Validate required fields and query parameters
+62 ;------------------------------------------------------
+63 ;Query Date/Time
SET QDATE=$GET(QRD(1))
+64 ;Query Format Code
SET FORMAT=$GET(QRD(2))
+65 ;Query Priority
SET PRI=$GET(QRD(3))
+66 ;Query ID - Request ID
SET REQID=$GET(QRD(4))
+67 ;Quantity Limited Request
SET QTY=$GET(QRD(7,1,1))
+68 ;Quantity Units
SET UNIT=$GET(QRD(7,1,2))
+69 ;What Subject Filter
SET WHAT=$GET(QRD(9,1,1))
+70 ;What Dept. Data Code - Request Type
SET REQTYPE=$GET(QRD(10))
+71 ;Where Subject Filter
SET WHERE=$GET(QRF(1))
+72 ;When Data Start Date/Time - From Date
SET FROMDT=$GET(QRF(2))
+73 ;When Data End Date/Time - To Date
SET TODT=$GET(QRF(3))
+74 ;
+75 IF QDATE=""
SET ERR="QRD^1^1^101^AE^Missing Query Date/Time"
QUIT 0
+76 IF '$$VALIDDT^MHV7RU(.QDATE)
SET ERR="QRD^1^1^102^AE^Invalid Query Date/Time"
QUIT 0
+77 ;
+78 IF FORMAT=""
SET ERR="QRD^1^2^101^AE^Missing Query Format Code"
QUIT 0
+79 IF FORMAT'="R"
SET ERR="QRD^1^2^102^AE^Invalid Query Format Code"
QUIT 0
+80 ;
+81 IF PRI=""
SET ERR="QRD^1^3^101^AE^Missing Query Priority"
QUIT 0
+82 IF ",D,I,"'[(","_PRI_",")
SET ERR="QRD^1^3^102^AE^Invalid Query Priority"
QUIT 0
+83 SET QRY("PRI")=PRI
+84 ;
+85 IF REQID=""
SET ERR="QRD^1^4^101^AE^Missing Request ID"
QUIT 0
+86 SET QRY("REQID")=REQID
+87 ;
+88 IF QTY'?0.N
SET ERR="QRD^1^7^102^AE^Invalid Quantity"
QUIT 0
+89 SET QRY("QTY")=+QTY
+90 SET XMT("MAX SIZE")=+QTY
+91 ;
+92 IF QTY
IF UNIT'="CH"
SET ERR="QRD^1^7^102^AE^Invalid Units"
QUIT 0
+93 ;
+94 IF WHAT=""
SET ERR="QRD^1^9^101^AE^Missing What Subject Filter"
QUIT 0
+95 ;
+96 IF REQTYPE=""
SET ERR="QRD^1^10^101^AE^Missing Request Type"
QUIT 0
+97 IF '$$VALRTYPE^MHV7RU(REQTYPE,.QRY,.ERR)
SET ERR="QRD^1^10^"_ERR
QUIT 0
+98 ;
+99 IF '$$VALIDWHO^MHV7RUS(.QRD,.QRY,.ERR)
QUIT 0
+100 ;
+101 IF WHERE=""
SET ERR="QRF^1^1^101^AE^Missing Where Subject Filter"
QUIT 0
+102 ;
+103 IF '$$VALIDDT^MHV7RU(.FROMDT)
SET ERR="QRF^1^2^102^AE^Invalid From Date"
QUIT 0
+104 SET QRY("FROM")=FROMDT
+105 IF '$$VALIDDT^MHV7RU(.TODT)
SET ERR="QRF^1^3^102^AE^Invalid To Date"
QUIT 0
+106 IF TODT'=""
IF TODT<FROMDT
SET ERR="QRF^1^3^102^AE^To Date precedes From Date"
QUIT 0
+107 SET QRY("TO")=TODT
+108 ;
+109 ; Get HL7 delimiters to be used in the response message
+110 ; Some extractors call APIs that require delimiters to be passed
+111 SET QRY("DELIM")=XMT("DELIM")
+112 IF XMT("MODE")="A"
SET QRY("DELIM")=$$DELIM^MHV7U(XMT("PROTOCOL"))
+113 ;
+114 QUIT 1
+115 ;
