MHV7R6 ;KUM - HL7 RECEIVER FOR TIU TITLES QUERY ; 1/5/13 10:34am
;;1.0;My HealtheVet;**10,11**;Aug 23, 2005;Build 61
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; Integration Agreements:
; 10104 : $$UP^XLFSTR
Q
;
QBPQ13 ;Process QBP^Q13 messages from the MHVSM QBP-Q13 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
;
; Integration Agreements
;
; 10104 UP^XLFSTR
;
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 query messages must contain QPD and RCP segments
; Any additional segments are ignored
;
; 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,STF,QPD,RCP,REQFLDS,REQID,REQTYPE,FROMDT,TODT,PRI,QTAG,QNAME,MHVDCIEN
N SEGTYPE,CNT,OCNT,RXNUM,QTY,UNIT,REQFLDS,CHKSEG
K QRY,ERR
S MHVDCIEN=0
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,RCP in any order
; PID and STF are optional. All 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="QPD" M QPD=@MSGROOT@(CNT),QRY("QPD")=QPD Q
. I SEGTYPE="RDF" M RDF=@MSGROOT@(CNT) Q
. Q
;
I '$D(QPD) S ERR="QPD^1^^100^AE^Missing QPD segment" Q 0
;
S QTAG=$G(QPD(1,1,2)) ;Query Tag
S REQID=$G(QPD(2)) ;Request ID
S REQTYPE=$G(QPD(3,1,1)) ;Request Type
S:REQTYPE="" REQTYPE=$G(QPD(3)) ;Request Type if no other params
;
; Validate required fields and query parameters
;------------------------------------------------------
;
; Check for missing/invalid fields
;
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^2^101^AE^Missing Request ID" Q 0
S (QRY("DCLSNM"),QRY("DFN"))=""
S QRY("REQID")=REQID
;
I REQTYPE="" S ERR="QPD^1^3^101^AE^Missing Request Type" Q 0
I '$$VALRTYPE^MHV7RU(REQTYPE,.QRY,.ERR) S ERR="QPD^1^3^"_ERR Q 0
;
I ERR Q 0
;
; Populate parameters 1-3 with the QPD segment data
;
S QRY("DCLSNM")=$G(QPD(3,1,3)) ;Document Class Name
I (REQTYPE="TIUTitlesByDocumentClass")&($D(QPD)) D
. I $G(QRY("DCLSNM"))="" S ERR="QPD^1^6^101^AE^Document Class Name cannot be null" Q
. S MHVDCIEN=$$DOCDEF^MHVXTIU($G(QRY("DCLSNM")))
. I $G(MHVDCIEN)=0 S ERR="QPD^1^6^102^AE^Document Class Name "_$G(QRY("DCLSNM"))_" Unknown."
;
;Added for MHV*1.0*11 - Validations for SMDSSUnitsByProviderAndAClinic query Input parameters
S QRY("ACLN")=$G(QPD(3,1,2))
S QRY("PDUZ")=$G(QPD(3,1,3))
I (REQTYPE="SMDSSUnitsByProviderAndClinic")&($D(QPD)) D
. I $G(QRY("ACLN"))="" S ERR="QPD^1^6^101^AE^DSS6-Associated Clinic cannot be null" Q
. I $G(QRY("PDUZ"))="" S ERR="QPD^1^6^102^AE^DSS5-Provider DUZ cannot be null" Q
I ERR Q 0
;
;Added for MHV*1.0*11 - Validations for SMECSProcedures query Input parameters
S QRY("DSSI")=$G(QPD(3,1,2))
S QRY("LOCI")=$G(QPD(3,1,3))
I (REQTYPE="SMECSProcedures")&($D(QPD)) D
. I $G(QRY("DSSI"))="" S ERR="QPD^1^6^101^AE^DSS Unit IEN cannot be null" Q
. I $G(QRY("LOCI"))="" S ERR="QPD^1^6^102^AE^Location IEN cannot be null" Q
I ERR Q 0
;
I ERR'="" Q 0
;
Q 1
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMHV7R6 5707 printed Apr 09, 2024@21:18:05 Page 2
MHV7R6 ;KUM - HL7 RECEIVER FOR TIU TITLES QUERY ; 1/5/13 10:34am
+1 ;;1.0;My HealtheVet;**10,11**;Aug 23, 2005;Build 61
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; Integration Agreements:
+5 ; 10104 : $$UP^XLFSTR
+6 QUIT
+7 ;
QBPQ13 ;Process QBP^Q13 messages from the MHVSM QBP-Q13 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 ; Integration Agreements
+22 ;
+23 ; 10104 UP^XLFSTR
+24 ;
+25 NEW MSGROOT,QRY,XMT,ERR,RNAME
+26 SET (QRY,XMT,ERR)=""
+27 ; Inbound query messages are small enough to be held in a local.
+28 ; The following lines commented out support use of global and are
+29 ; left in case use a global becomes necessary.
+30 ;S MSGROOT="^TMP(""MHV7"",$J)"
+31 ;K @MSGROOT
+32 SET MSGROOT="MHV7MSG"
+33 NEW MHV7MSG
+34 ;Load inbound message information
DO LOADXMT^MHV7U(.XMT)
+35 ;
+36 SET RNAME=XMT("MESSAGE TYPE")_"-"_XMT("EVENT TYPE")_" RECEIVER"
+37 DO LOG^MHVUL2(RNAME,"BEGIN","S","TRACE")
+38 ;
+39 DO LOADMSG^MHV7U(MSGROOT)
+40 DO LOG^MHVUL2("LOAD",MSGROOT,"I","DEBUG")
+41 ;
+42 DO PARSEMSG^MHV7U(MSGROOT,.HL)
+43 DO LOG^MHVUL2("PARSE",MSGROOT,"I","DEBUG")
+44 ;
+45 IF '$$VALIDMSG(MSGROOT,.QRY,.XMT,.ERR)
Begin DoDot:1
+46 DO LOG^MHVUL2("MSG CHECK","INVALID^"_ERR,"S","ERROR")
+47 DO XMIT^MHV7T(.QRY,.XMT,ERR,"",.HL)
End DoDot:1
QUIT
+48 DO LOG^MHVUL2("MSG CHECK","VALID","S","TRACE")
+49 ;
+50 ; Immediate Mode
+51 ; Deferred mode queries are not supported at this time
+52 DO REALTIME^MHVRQI(.QRY,.XMT,.HL)
+53 ;
+54 DO LOG^MHVUL2(RNAME,"END","S","TRACE")
+55 ;Clean up TMP used by logging
DO RESET^MHVUL2
+56 ;K @MSGROOT
+57 ;
+58 QUIT
+59 ;
VALIDMSG(MSGROOT,QRY,XMT,ERR) ;Validate message
+1 ;
+2 ; Messages handled: QBP^Q13
+3 ;
+4 ; QBP query messages must contain QPD and RCP segments
+5 ; Any additional segments are ignored
+6 ;
+7 ; Input:
+8 ; MSGROOT - Root of array holding message
+9 ; XMT - Transmission parameters
+10 ;
+11 ; Output:
+12 ; QRY - Query Array
+13 ; XMT - Transmission parameters
+14 ; ERR - segment^sequence^field^code^ACK type^error text
+15 ;
+16 NEW MSH,PID,STF,QPD,RCP,REQFLDS,REQID,REQTYPE,FROMDT,TODT,PRI,QTAG,QNAME,MHVDCIEN
+17 NEW SEGTYPE,CNT,OCNT,RXNUM,QTY,UNIT,REQFLDS,CHKSEG
+18 KILL QRY,ERR
+19 SET MHVDCIEN=0
+20 SET ERR=""
+21 ;
+22 ; Set up basics for responding to message.
+23 ;-----------------------------------------
+24 ;Message ID
SET QRY("MID")=XMT("MID")
+25 SET QRY("QPD")=""
+26 ;
+27 ; Validate message is a well-formed QBP query message.
+28 ;-----------------------------------------------------------
+29 ; Must have MSH first, followed by QPD,RCP in any order
+30 ; PID and STF are optional. All other segments are ignored.
+31 ;
+32 IF $GET(@MSGROOT@(1,0))="MSH"
MERGE MSH=@MSGROOT@(1)
+33 IF '$TEST
SET ERR="MSH^1^^100^AE^Missing MSH segment"
QUIT 0
+34 ;
+35 SET CNT=2
SET OCNT=0
+36 FOR
if '$DATA(@MSGROOT@(CNT))
QUIT
Begin DoDot:1
+37 SET SEGTYPE=$GET(@MSGROOT@(CNT,0))
+38 IF SEGTYPE="QPD"
MERGE QPD=@MSGROOT@(CNT),QRY("QPD")=QPD
QUIT
+39 IF SEGTYPE="RDF"
MERGE RDF=@MSGROOT@(CNT)
QUIT
+40 QUIT
End DoDot:1
SET CNT=CNT+1
+41 ;
+42 IF '$DATA(QPD)
SET ERR="QPD^1^^100^AE^Missing QPD segment"
QUIT 0
+43 ;
+44 ;Query Tag
SET QTAG=$GET(QPD(1,1,2))
+45 ;Request ID
SET REQID=$GET(QPD(2))
+46 ;Request Type
SET REQTYPE=$GET(QPD(3,1,1))
+47 ;Request Type if no other params
if REQTYPE=""
SET REQTYPE=$GET(QPD(3))
+48 ;
+49 ; Validate required fields and query parameters
+50 ;------------------------------------------------------
+51 ;
+52 ; Check for missing/invalid fields
+53 ;
+54 IF '$DATA(QPD(1))
SET ERR="QPD^1^1^101^AE^Missing Message Query Name"
QUIT 0
+55 ;Message Query Name
MERGE QNAME=QPD(1)
+56 ;
+57 IF QTAG=""
SET ERR="QPD^1^2^101^AE^Missing Query Tag"
QUIT 0
+58 IF REQID=""
SET ERR="QPD^1^2^101^AE^Missing Request ID"
QUIT 0
+59 SET (QRY("DCLSNM"),QRY("DFN"))=""
+60 SET QRY("REQID")=REQID
+61 ;
+62 IF REQTYPE=""
SET ERR="QPD^1^3^101^AE^Missing Request Type"
QUIT 0
+63 IF '$$VALRTYPE^MHV7RU(REQTYPE,.QRY,.ERR)
SET ERR="QPD^1^3^"_ERR
QUIT 0
+64 ;
+65 IF ERR
QUIT 0
+66 ;
+67 ; Populate parameters 1-3 with the QPD segment data
+68 ;
+69 ;Document Class Name
SET QRY("DCLSNM")=$GET(QPD(3,1,3))
+70 IF (REQTYPE="TIUTitlesByDocumentClass")&($DATA(QPD))
Begin DoDot:1
+71 IF $GET(QRY("DCLSNM"))=""
SET ERR="QPD^1^6^101^AE^Document Class Name cannot be null"
QUIT
+72 SET MHVDCIEN=$$DOCDEF^MHVXTIU($GET(QRY("DCLSNM")))
+73 IF $GET(MHVDCIEN)=0
SET ERR="QPD^1^6^102^AE^Document Class Name "_$GET(QRY("DCLSNM"))_" Unknown."
End DoDot:1
+74 ;
+75 ;Added for MHV*1.0*11 - Validations for SMDSSUnitsByProviderAndAClinic query Input parameters
+76 SET QRY("ACLN")=$GET(QPD(3,1,2))
+77 SET QRY("PDUZ")=$GET(QPD(3,1,3))
+78 IF (REQTYPE="SMDSSUnitsByProviderAndClinic")&($DATA(QPD))
Begin DoDot:1
+79 IF $GET(QRY("ACLN"))=""
SET ERR="QPD^1^6^101^AE^DSS6-Associated Clinic cannot be null"
QUIT
+80 IF $GET(QRY("PDUZ"))=""
SET ERR="QPD^1^6^102^AE^DSS5-Provider DUZ cannot be null"
QUIT
End DoDot:1
+81 IF ERR
QUIT 0
+82 ;
+83 ;Added for MHV*1.0*11 - Validations for SMECSProcedures query Input parameters
+84 SET QRY("DSSI")=$GET(QPD(3,1,2))
+85 SET QRY("LOCI")=$GET(QPD(3,1,3))
+86 IF (REQTYPE="SMECSProcedures")&($DATA(QPD))
Begin DoDot:1
+87 IF $GET(QRY("DSSI"))=""
SET ERR="QPD^1^6^101^AE^DSS Unit IEN cannot be null"
QUIT
+88 IF $GET(QRY("LOCI"))=""
SET ERR="QPD^1^6^102^AE^Location IEN cannot be null"
QUIT
End DoDot:1
+89 IF ERR
QUIT 0
+90 ;
+91 IF ERR'=""
QUIT 0
+92 ;
+93 QUIT 1
+94 ;
