- 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 Jan 18, 2025@03:16:59 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 ;