Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MHV7R5

MHV7R5.m

Go to the documentation of this file.
  1. MHV7R5 ;WAS/DLF/MJK/KUM - HL7 RECEIVER FOR ADMIN QUERIES ; 6/7/10 10:34am
  1. ;;1.0;My HealtheVet;**6,10,11**;Aug 23, 2005;Build 61
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ; Integration Agreements:
  1. ; 10104 : $$UP^XLFSTR
  1. Q
  1. ;
  1. QBPQ11 ;Process QBP^Q11 messages from the MHVSM QBP-Q11 Subscriber protocol
  1. ;
  1. ; This routine and subroutines assume that all VistA HL7 environment
  1. ; variables are properly initialized and will produce a fatal error
  1. ; if they are missing.
  1. ;
  1. ; The message will be checked to see if it is a valid query.
  1. ; If not a negative acknowledgement will be sent. If the query is an
  1. ; immediate mode or synchronous query, the realtime request manager
  1. ; is called to handle the query. This means the query will be
  1. ; processed and a response generated immediately.
  1. ; In the future deferred mode queries may be filed in a database for
  1. ; later processing, or transmission.
  1. ;
  1. ; Input:
  1. ; HL7 environment variables
  1. ;
  1. ; Output:
  1. ; Processed query or negative acknowledgement
  1. ; If handled real-time the query response is generated
  1. ;
  1. ; Integration Agreements
  1. ;
  1. ; 10104 UP^XLFSTR
  1. ;
  1. N MSGROOT,QRY,XMT,ERR,RNAME
  1. S (QRY,XMT,ERR)=""
  1. ; Inbound query messages are small enough to be held in a local.
  1. ; The following lines commented out support use of global and are
  1. ; left in case use a global becomes necessary.
  1. ;S MSGROOT="^TMP(""MHV7"",$J)"
  1. ;K @MSGROOT
  1. S MSGROOT="MHV7MSG"
  1. N MHV7MSG
  1. D LOADXMT^MHV7U(.XMT) ;Load inbound message information
  1. ;
  1. S RNAME=XMT("MESSAGE TYPE")_"-"_XMT("EVENT TYPE")_" RECEIVER"
  1. D LOG^MHVUL2(RNAME,"BEGIN","S","TRACE")
  1. ;
  1. D LOADMSG^MHV7U(MSGROOT)
  1. D LOG^MHVUL2("LOAD",MSGROOT,"I","DEBUG")
  1. ;
  1. D PARSEMSG^MHV7U(MSGROOT,.HL)
  1. D LOG^MHVUL2("PARSE",MSGROOT,"I","DEBUG")
  1. ;
  1. I '$$VALIDMSG(MSGROOT,.QRY,.XMT,.ERR) D Q
  1. . D LOG^MHVUL2("MSG CHECK","INVALID^"_ERR,"S","ERROR")
  1. . D XMIT^MHV7T(.QRY,.XMT,ERR,"",.HL)
  1. D LOG^MHVUL2("MSG CHECK","VALID","S","TRACE")
  1. ;
  1. ; Immediate Mode
  1. ; Deferred mode queries are not supported at this time
  1. D REALTIME^MHVRQI(.QRY,.XMT,.HL)
  1. ;
  1. D LOG^MHVUL2(RNAME,"END","S","TRACE")
  1. D RESET^MHVUL2 ;Clean up TMP used by logging
  1. ;K @MSGROOT
  1. ;
  1. Q
  1. ;
  1. VALIDMSG(MSGROOT,QRY,XMT,ERR) ;Validate message
  1. ;
  1. ; Messages handled: QBP^Q11
  1. ;
  1. ; QBP query messages must contain QPD and RCP segments
  1. ; Any additional segments are ignored
  1. ;
  1. ; Input:
  1. ; MSGROOT - Root of array holding message
  1. ; XMT - Transmission parameters
  1. ;
  1. ; Output:
  1. ; QRY - Query Array
  1. ; XMT - Transmission parameters
  1. ; ERR - segment^sequence^field^code^ACK type^error text
  1. ;
  1. N MSH,PID,STF,QPD,RCP,REQFLDS,REQID,REQTYPE,FROMDT,TODT,PRI,QTAG,QNAME,MHVCSIE
  1. N SEGTYPE,CNT,OCNT,RXNUM,QTY,UNIT,REQFLDS,CHKSEG
  1. K QRY,ERR
  1. S MHVCSIE=""
  1. S ERR=""
  1. ;
  1. ; Set up basics for responding to message.
  1. ;-----------------------------------------
  1. S QRY("MID")=XMT("MID") ;Message ID
  1. S QRY("QPD")=""
  1. ;
  1. ; Validate message is a well-formed QBP query message.
  1. ;-----------------------------------------------------------
  1. ; Must have MSH first, followed by QPD,RCP in any order
  1. ; PID and STF are optional. All other segments are ignored.
  1. ;
  1. I $G(@MSGROOT@(1,0))="MSH" M MSH=@MSGROOT@(1)
  1. E S ERR="MSH^1^^100^AE^Missing MSH segment" Q 0
  1. ;
  1. S CNT=2,OCNT=0
  1. F Q:'$D(@MSGROOT@(CNT)) D S CNT=CNT+1
  1. . S SEGTYPE=$G(@MSGROOT@(CNT,0))
  1. . I SEGTYPE="PID" M PID=@MSGROOT@(CNT),QRY("PID")=PID Q
  1. . I SEGTYPE="STF" M STF=@MSGROOT@(CNT),QRY("STF")=STF Q
  1. . I SEGTYPE="QPD" M QPD=@MSGROOT@(CNT),QRY("QPD")=QPD Q
  1. . I SEGTYPE="RCP" M RCP=@MSGROOT@(CNT),QRY("RCP")=RCP Q
  1. . Q
  1. ;
  1. I '$D(QPD) S ERR="QPD^1^^100^AE^Missing QPD segment" Q 0
  1. ;
  1. S QTAG=$G(QPD(1,1,2)) ;Query Tag
  1. S REQID=$G(QPD(2)) ;Request ID
  1. S REQTYPE=$G(QPD(3,1,1)) ;Request Type
  1. S PRI=$G(RCP(1)) ;Query Priority
  1. S QTY=$G(RCP(2,1,1)) ;Quantity Limited
  1. S UNIT=$G(RCP(2,1,2)) ;Quantity units
  1. S:REQTYPE="" REQTYPE=$G(QPD(3)) ;Request Type if no other params
  1. ;
  1. ; Validate required fields and query parameters
  1. ;------------------------------------------------------
  1. ;
  1. ; Check for missing/invalid fields
  1. ;
  1. I '$D(QPD(1)) S ERR="QPD^1^1^101^AE^Missing Message Query Name" Q 0
  1. M QNAME=QPD(1) ;Message Query Name
  1. ;
  1. I QTAG="" S ERR="QPD^1^2^101^AE^Missing Query Tag" Q 0
  1. I REQID="" S ERR="QPD^1^2^101^AE^Missing Request ID" Q 0
  1. S (QRY("IEN"),QRY("LNAME"),QRY("FNAME"),QRY("DFN"))=""
  1. S QRY("REQID")=REQID
  1. ;
  1. I REQTYPE="" S ERR="QPD^1^3^101^AE^Missing Request Type" Q 0
  1. I '$$VALRTYPE^MHV7RU(REQTYPE,.QRY,.ERR) S ERR="QPD^1^3^"_ERR Q 0
  1. ;
  1. ; If we have a PID, validate it and populate query parameters
  1. ; from the PID.
  1. ;
  1. I $D(PID) D VALIDPID
  1. ;
  1. ; If we have a STF, validate it and populate query parameters
  1. ; from the STF.
  1. ;
  1. I $D(STF) D VALIDSTF
  1. ;
  1. I ERR Q 0
  1. ;
  1. ; If no PID or STF segment sent, Populate parameters 1-3 with the
  1. ; QPD segment data
  1. ;
  1. I '$D(PID),'$D(STF) D
  1. .S QRY("IEN")=$G(QPD(3,1,2)) ;ien
  1. .S QRY("LNAME")=$$UP^XLFSTR($G(QPD(3,1,3))) ;Last Name
  1. .S QRY("FNAME")=$$UP^XLFSTR($G(QPD(3,1,4))) ;First Name
  1. .S QRY("PICN")=$$UP^XLFSTR($G(QPD(3,1,2))) ;Patient ICN
  1. .S QRY("DSSI")=$$UP^XLFSTR($G(QPD(3,1,3))) ;DSS Unit IEN
  1. .S QRY("PRDT")=DT ;Procedure Date and Time
  1. .S QRY("DSRCH")=$$UP^XLFSTR($G(QPD(3,1,3))) ;Diagnoses Search String
  1. .S QRY("FROMDT")=$$UP^XLFSTR($G(QPD(3,1,5))) ;From Date
  1. .S QRY("TODT")=$$UP^XLFSTR($G(QPD(3,1,6))) ;To Date
  1. ;
  1. ;Added for MHV*1.0*10 - Validations for SMClinicsByStopCode query Input parameters
  1. I (REQTYPE="SMClinicsByStopCode")&($D(QPD)) D
  1. . I $G(QRY("FNAME"))="" S ERR="QPD^1^6^101^AE^Clinic Secondary(Credit) Stop Code cannot be null" Q
  1. . I ((+$G(QRY("FNAME"))<1)&(+$G(QRY("FNAME"))>999)) S ERR="QPD^1^6^102^AE^Clinic Secondary(Credit) Stop Code "_$G(QRY("FNAME"))_" should be a numeric value in the range 1 to 999." Q
  1. . S MHVCSIE=$$SCIEN^MHVXCLN($G(QRY("FNAME")))
  1. . I $G(MHVCSIE)="" S ERR="QPD^1^6^102^AE^Clinic Secondary(Credit) Stop Code "_$G(QRY("FNAME"))_" Unknown."
  1. ;
  1. ;Added for MHV*1.0*11 - Validations for SMPCMMPatientsForClinic query Input parameters
  1. I (REQTYPE="SMPCMMPatientsForClinic")&($D(QPD)) D
  1. . I $G(QRY("IEN"))="" S ERR="QPD^1^6^101^AE^Clinic IEN cannot be null" Q
  1. ;
  1. ;Added for MHV*1.0*11 - Validations for SMPATEligClassification query Input parameters
  1. I (REQTYPE="SMPatientEClass")&($D(QPD)) D
  1. . I $G(QRY("PICN"))="" S ERR="QPD^1^6^101^AE^Patient ICN cannot be null" Q
  1. . I $G(QRY("DSSI"))="" S ERR="QPD^1^6^102^AE^DSS Unit IEN cannot be null" Q
  1. . I $G(QRY("PRDT"))="" S ERR="QPD^1^6^103^AE^Procedure Date and Time cannot be null" Q
  1. ;
  1. ;Added for MHV*1.0*11 - Validations for SMPatientProblems input parameters
  1. I (REQTYPE="SMPatientProblems")&($D(QPD)) D
  1. . I $G(QRY("PICN"))="" S ERR="QPD^1^6^101^AE^Patient ICN cannot be null" Q
  1. ;
  1. ;Added for MHV*1.0*11 - Validations for SMDiagnoses input parameters
  1. I (REQTYPE="SMDiagnoses")&($D(QPD)) D
  1. . I $G(QRY("DSRCH"))="" S ERR="QPD^1^6^101^AE^Diagnoses Search String cannot be null" Q
  1. I ERR Q 0
  1. ;
  1. S FROMDT=$G(QPD(3,1,5)) ;From Date
  1. S TODT=$G(QPD(3,1,6)) ;To Date
  1. ;
  1. ; Validate from and to date if present
  1. ;
  1. I FROMDT]"" D
  1. .I '$$VALIDDT^MHV7RU(.FROMDT) S ERR="QPD^1^7^102^AE^Invalid From Date"
  1. I TODT]"" D
  1. .I '$$VALIDDT^MHV7RU(.TODT) S ERR="QPD^1^8^102^AE^Invalid To Date"
  1. .I TODT'="",TODT<FROMDT D
  1. ..S ERR="QPD^1^6^102^AE^To Date precedes From Date"
  1. S QRY("FROMDT")=FROMDT,QRY("TODT")=TODT
  1. I ERR'="" Q 0
  1. ;
  1. I PRI="" S ERR="RCP^1^1^101^AE^Missing Query Priority" Q 0
  1. I ",D,I,"'[(","_PRI_",") S ERR="RCP^1^1^102^AE^Invalid Query Priority" Q 0
  1. S QRY("PRI")=PRI
  1. Q:ERR'="" 0
  1. ;
  1. Q 1
  1. ;
  1. VALIDPID ;
  1. ;
  1. ; If the IEN was sent, call the validation utility for
  1. ; PID segments
  1. ;
  1. I $D(PID(3,1,1)) D
  1. .S CHKSEG=$$VALIDPID^MHV7RUS(.PID,.QRY,.ERR)
  1. .S QRY("IEN")=QRY("DFN")
  1. ;
  1. ; If no IEN, populate parameters for name
  1. ;
  1. I QRY("IEN")="",ERR="" D
  1. .S QRY("LNAME")=$$UP^XLFSTR(PID(5,1,1))
  1. .S:$D(PID(5,1,2)) QRY("FNAME")=$$UP^XLFSTR(PID(5,1,2))
  1. Q
  1. VALIDSTF ;
  1. ;
  1. ; If the IEN was sent, call the validation utility for
  1. ; STF segments
  1. ;
  1. I $D(STF(2)) D Q
  1. .S QRY("IEN")=$G(STF(2,1,1))
  1. ;
  1. ; If no IEN, populate parameters for name
  1. ;
  1. I $G(STF(3))]"" S QRY("LNAME")=$$UP^XLFSTR($TR(STF(3),"^",""))
  1. I $G(STF(3,1,1))'="" S QRY("LNAME")=$$UP^XLFSTR(STF(3,1,1))
  1. I $G(STF(3,1,2))'="" S QRY("FNAME")=$$UP^XLFSTR(STF(3,1,2))
  1. Q