MHV7R7 ;KUM - HL7 RECEIVER FOR ADMIN QUERIES ; 6/7/10 10:34am
;;1.0;My HealtheVet;**11**;Aug 23, 2005;Build 61
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; Integration Agreements:
; 10104 : $$UP^XLFSTR
; 10104 : $$REPLACE^XLFSTR
Q
;
DFTP03 ;Process DFT^P03 messages from the MHVSM DFT-P03 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: DFT^P03
;
; QBP query messages must contain FT1, EVN, PID, PV1, ZEL 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,MHVCSIE
N SEGTYPE,CNT,OCNT,RXNUM,QTY,UNIT,REQFLDS,CHKSEG
K QRY,ERR
S MHVCSIE=""
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 DFT query message.
;-----------------------------------------------------------
; Must have MSH first, followed by FT1,EVN,PID,PV1,ZEL in any order
; 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="FT1" M FT1=@MSGROOT@(CNT),QRY("FT1")=FT1 Q
. I SEGTYPE="EVN" M EVN=@MSGROOT@(CNT),QRY("EVN")=EVN Q
. I SEGTYPE="PID" M PID=@MSGROOT@(CNT),QRY("PID")=PID Q
. I SEGTYPE="PV1" M PV1=@MSGROOT@(CNT),QRY("PV1")=PV1 Q
. I SEGTYPE="ZEL" M ZEL=@MSGROOT@(CNT),QRY("ZEL")=ZEL Q
. Q
;
I '$D(FT1) S ERR="FT1^1^^100^AE^Missing FT1 segment" Q 0
I '$D(EVN) S ERR="EVN^1^^100^AE^Missing EVN segment" Q 0
I '$D(PID) S ERR="PID^1^^100^AE^Missing PID segment" Q 0
I '$D(PV1) S ERR="PV1^1^^100^AE^Missing PV1 segment" Q 0
I '$D(ZEL) S ERR="ZEL^1^^100^AE^Missing ZEL segment" Q 0
;
S (QRY("ECFILE"),QRY("ECL"),QRY("ECD"),QRY("ECC"),QRY("ECDT"),QRY("ECP"),QRY("ECICN"),QRY("ECMN"),QRY("ECDUZ"))=""
S (QRY("ECPTSTAT"),QRY("ECP"),QRY("ECDX"),QRY("EC4"),QRY("ECELCL"))=""
;
S REQTYPE="SMFiler"
I REQTYPE="" S ERR="MSH^1^3^101^AE^Missing Request Type" Q 0
I '$$VALRTYPE^MHV7RU(REQTYPE,.QRY,.ERR) S ERR="FT1^1^3^"_ERR Q 0
;
I ERR Q 0
;
I $D(FT1) D
.S QRY("ECFILE")=$G(FT1(6)) ;File Number
.S QRY("ECD")=$G(FT1(13)) ; DSS Unit IEN
.S QRY("ECP")=$G(FT1(25,1,2)) ;Procedure
.; Diagnosis codes are seperated by ^. make change from ^ to ;
.S MHVSPEC("^")=";"
.S QRY("ECDX")=$$REPLACE^XLFSTR($G(FT1(19)),.MHVSPEC)
I $D(EVN) D
.S QRY("ECL")=$G(EVN(7,1,2)) ;Location IEN
.S QRY("ECDT")=$G(EVN(2)) ;Procedure Date and Time
.S QRY("ECDUZ")=$G(EVN(5)) ;Enter/Edited By
I $D(PID) D
.S QRY("ECICN")=$G(PID(3)) ;Patient ICN
I $D(PV1) D
.S QRY("ECMN")=$G(PV1(10)) ;Ordering Section
.; Providers are seperated by ^. Please make change from ^ to ;.
.S MHVSPEC("^")=";"
.S QRY("ECU")=$$REPLACE^XLFSTR($G(PV1(7)),.MHVSPEC)
.S QRY("EC4")=$G(PV1(3,1,4,2)) ;Associated Clinic
I $D(ZEL) D
.S QRY("ECPTSTAT")=$G(ZEL(9)) ;Patient Status
.; File classification AO^IR^SC^EC^MST^HNC^C^Project SHAD
.S QRY("ECELCL")=$G(ZEL(2))_";"_$G(ZEL(18))_";"_$G(ZEL(19))_";"_$G(ZEL(31))_";"_$G(ZEL(20))_";"_$G(ZEL(23))_";"
.S QRY("ECELCL")=QRY("ECELCL")_$G(ZEL(42))_";"_$G(ZEL(37))_";"_$G(ZEL(44))
S QRY("ECC")=0
; All validations should be in Validation routine.
S MHVSTR=$G(QRY("ECFILE"))_"^"_$G(QRY("ECL"))_"^"_$G(QRY("ECD"))_"^"_$G(QRY("ECC"))_"^"_$G(QRY("ECDT"))_"^"
S MHVSTR=MHVSTR_$G(QRY("ECP"))_"^"_$G(QRY("ECICN"))_"^"_$G(QRY("ECMN"))_"^"_$G(QRY("ECDUZ"))_"^"_$G(QRY("ECPTSTAT"))_"^"
S MHVSTR=MHVSTR_$G(QRY("ECU"))_"^"_$G(QRY("ECDX"))_"^"_$G(QRY("EC4"))_"^"_$G(QRY("ECELCL"))
;
;Validations for SMFiler input parameters are in ECFLRPC as they are complex and more
;
I ERR'="" Q 0
;
Q 1
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMHV7R7 6178 printed Dec 13, 2024@02:15:58 Page 2
MHV7R7 ;KUM - HL7 RECEIVER FOR ADMIN QUERIES ; 6/7/10 10:34am
+1 ;;1.0;My HealtheVet;**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 ; 10104 : $$REPLACE^XLFSTR
+7 QUIT
+8 ;
DFTP03 ;Process DFT^P03 messages from the MHVSM DFT-P03 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: DFT^P03
+3 ;
+4 ; QBP query messages must contain FT1, EVN, PID, PV1, ZEL 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,MHVCSIE
+17 NEW SEGTYPE,CNT,OCNT,RXNUM,QTY,UNIT,REQFLDS,CHKSEG
+18 KILL QRY,ERR
+19 SET MHVCSIE=""
+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 DFT query message.
+28 ;-----------------------------------------------------------
+29 ; Must have MSH first, followed by FT1,EVN,PID,PV1,ZEL in any order
+30 ; 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="FT1"
MERGE FT1=@MSGROOT@(CNT),QRY("FT1")=FT1
QUIT
+39 IF SEGTYPE="EVN"
MERGE EVN=@MSGROOT@(CNT),QRY("EVN")=EVN
QUIT
+40 IF SEGTYPE="PID"
MERGE PID=@MSGROOT@(CNT),QRY("PID")=PID
QUIT
+41 IF SEGTYPE="PV1"
MERGE PV1=@MSGROOT@(CNT),QRY("PV1")=PV1
QUIT
+42 IF SEGTYPE="ZEL"
MERGE ZEL=@MSGROOT@(CNT),QRY("ZEL")=ZEL
QUIT
+43 QUIT
End DoDot:1
SET CNT=CNT+1
+44 ;
+45 IF '$DATA(FT1)
SET ERR="FT1^1^^100^AE^Missing FT1 segment"
QUIT 0
+46 IF '$DATA(EVN)
SET ERR="EVN^1^^100^AE^Missing EVN segment"
QUIT 0
+47 IF '$DATA(PID)
SET ERR="PID^1^^100^AE^Missing PID segment"
QUIT 0
+48 IF '$DATA(PV1)
SET ERR="PV1^1^^100^AE^Missing PV1 segment"
QUIT 0
+49 IF '$DATA(ZEL)
SET ERR="ZEL^1^^100^AE^Missing ZEL segment"
QUIT 0
+50 ;
+51 SET (QRY("ECFILE"),QRY("ECL"),QRY("ECD"),QRY("ECC"),QRY("ECDT"),QRY("ECP"),QRY("ECICN"),QRY("ECMN"),QRY("ECDUZ"))=""
+52 SET (QRY("ECPTSTAT"),QRY("ECP"),QRY("ECDX"),QRY("EC4"),QRY("ECELCL"))=""
+53 ;
+54 SET REQTYPE="SMFiler"
+55 IF REQTYPE=""
SET ERR="MSH^1^3^101^AE^Missing Request Type"
QUIT 0
+56 IF '$$VALRTYPE^MHV7RU(REQTYPE,.QRY,.ERR)
SET ERR="FT1^1^3^"_ERR
QUIT 0
+57 ;
+58 IF ERR
QUIT 0
+59 ;
+60 IF $DATA(FT1)
Begin DoDot:1
+61 ;File Number
SET QRY("ECFILE")=$GET(FT1(6))
+62 ; DSS Unit IEN
SET QRY("ECD")=$GET(FT1(13))
+63 ;Procedure
SET QRY("ECP")=$GET(FT1(25,1,2))
+64 ; Diagnosis codes are seperated by ^. make change from ^ to ;
+65 SET MHVSPEC("^")=";"
+66 SET QRY("ECDX")=$$REPLACE^XLFSTR($GET(FT1(19)),.MHVSPEC)
End DoDot:1
+67 IF $DATA(EVN)
Begin DoDot:1
+68 ;Location IEN
SET QRY("ECL")=$GET(EVN(7,1,2))
+69 ;Procedure Date and Time
SET QRY("ECDT")=$GET(EVN(2))
+70 ;Enter/Edited By
SET QRY("ECDUZ")=$GET(EVN(5))
End DoDot:1
+71 IF $DATA(PID)
Begin DoDot:1
+72 ;Patient ICN
SET QRY("ECICN")=$GET(PID(3))
End DoDot:1
+73 IF $DATA(PV1)
Begin DoDot:1
+74 ;Ordering Section
SET QRY("ECMN")=$GET(PV1(10))
+75 ; Providers are seperated by ^. Please make change from ^ to ;.
+76 SET MHVSPEC("^")=";"
+77 SET QRY("ECU")=$$REPLACE^XLFSTR($GET(PV1(7)),.MHVSPEC)
+78 ;Associated Clinic
SET QRY("EC4")=$GET(PV1(3,1,4,2))
End DoDot:1
+79 IF $DATA(ZEL)
Begin DoDot:1
+80 ;Patient Status
SET QRY("ECPTSTAT")=$GET(ZEL(9))
+81 ; File classification AO^IR^SC^EC^MST^HNC^C^Project SHAD
+82 SET QRY("ECELCL")=$GET(ZEL(2))_";"_$GET(ZEL(18))_";"_$GET(ZEL(19))_";"_$GET(ZEL(31))_";"_$GET(ZEL(20))_";"_$GET(ZEL(23))_";"
+83 SET QRY("ECELCL")=QRY("ECELCL")_$GET(ZEL(42))_";"_$GET(ZEL(37))_";"_$GET(ZEL(44))
End DoDot:1
+84 SET QRY("ECC")=0
+85 ; All validations should be in Validation routine.
+86 SET MHVSTR=$GET(QRY("ECFILE"))_"^"_$GET(QRY("ECL"))_"^"_$GET(QRY("ECD"))_"^"_$GET(QRY("ECC"))_"^"_$GET(QRY("ECDT"))_"^"
+87 SET MHVSTR=MHVSTR_$GET(QRY("ECP"))_"^"_$GET(QRY("ECICN"))_"^"_$GET(QRY("ECMN"))_"^"_$GET(QRY("ECDUZ"))_"^"_$GET(QRY("ECPTSTAT"))_"^"
+88 SET MHVSTR=MHVSTR_$GET(QRY("ECU"))_"^"_$GET(QRY("ECDX"))_"^"_$GET(QRY("EC4"))_"^"_$GET(QRY("ECELCL"))
+89 ;
+90 ;Validations for SMFiler input parameters are in ECFLRPC as they are complex and more
+91 ;
+92 IF ERR'=""
QUIT 0
+93 ;
+94 QUIT 1
+95 ;
