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

INHQRIN.m

Go to the documentation of this file.
  1. INHQRIN ; dmw ; 17 Aug 1999 17:54; Process Inbound Generic Query
  1. ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1. ;COPYRIGHT 1991-2000 SAIC
  1. ;;This supports inbound HL7 query messages. It is specific to CHCS.
  1. ;;As the IHS develops its own query capbility, this routine should
  1. ;;be modified or used as a template for the incoming messages.
  1. ;W $$ROUDOC^DGFUNC2("INHQRIN") Q
  1. ;
  1. ; Invoked by:
  1. ; Inbound query script (HL GIS QUERY IN)
  1. ; Invokes application query/response routines, based on category
  1. ; of query
  1. ; Input variables:
  1. ; INV - array with field values from inbound message
  1. ; UIF - Universal Interface File IEN for Query Message
  1. ; Output variables:
  1. ; INOA - array of data used by the GIS to process inbound
  1. ; queries and return responses
  1. ; INQA - array of data needed by application teams to process
  1. ; responses to query
  1. ; INQA("INQPID") = CHCS Patient IEN
  1. ; INQA("INQCAT") = Category of query
  1. ; INQA("INQFRM") = Begin date for response processing
  1. ; INQA("INQTHRU") = End date for response processing
  1. ; INQA("INQWHICH") = Date used for processing
  1. ; INQA("INQUID") = Unique ID for category
  1. ;
  1. EN ; Entry point for inbound query processing.
  1. N INQA,INXV
  1. ;
  1. ; If unique identifier exists (Lab and Rad only), bypass other checks
  1. ; and invoke application
  1. ; Get OTHER QRY SUBJECT FILTER from INV array
  1. ; Sub-components:
  1. ; 1 - Lab accession number
  1. ; 2 - Radiology exam number)
  1. ; ** NOTES: This is not the IEN of the identity, but the actual
  1. ; assigned number. If multiple values are transmitted, only
  1. ; the first value encountered will be processed by the
  1. ; application.
  1. ;
  1. ; No validation of this value occurs within this function.
  1. ; It will be passed to the application routine as it is
  1. ; received.
  1. ; If data in OTHER QRY SUBJECT FILTER, set unique ID and category.
  1. ; Go to MISC
  1. ;
  1. I $$UID() D MISC Q
  1. I '$$WHO() D LOGERR("No unique CHCS patient identified.") Q
  1. I '$$WHAT() D LOGERR("No Query Category defined.") Q
  1. D WHEN,MISC
  1. Q
  1. UID() S INXV=$G(@INV@("QRF5.1")) I $L(INXV) S INQA("INQUID")=INXV,INQA("INQCAT")="LAB" Q 1
  1. S INXV=$G(@INV@("QRF5.2")) I $L(INXV) S INQA("INQUID")=INXV,INQA("INQCAT")="RAD" Q 1
  1. Q 0
  1. ;
  1. WHO() ; Find CHCS patient
  1. ; Get WHO SUBJECT FILTER from INV array (INV("QRD8")
  1. ; Sub-components:
  1. ; 1 - CHCS Patient IEN
  1. ; 2 - Patient Family Name
  1. ; 3 - Patient Given Name
  1. ; 4 - Patient Middle Name/Initial
  1. ; 10 - Patient FMP/SSN
  1. ; If valid CHCS patient IEN, set INQA("INQPID")=IEN.
  1. ;
  1. ; Note: See description in field definition, HL QUERY WHO SUBJECT
  1. ; FILTER, for design considerations.
  1. F INXV=1,2,3,4,10 S @INV@("QRD8."_INXV)=$P($G(@INV@("QRD8")),SUBDELIM,INXV)
  1. S INXV=$G(@INV@("QRD8.1")) I $G(INXV),$D(^DPT(INXV)) S INQA("INQPID")=INXV Q 1
  1. ; If valid patient FMP/SSN, get patient IEN. Set INQA("INQPID")=IEN.
  1. S INXV=$G(@INV@("QRD8.10")) I INXV["/" S INQA("INQPID")=$$GETPAT(INXV) I $G(INQA("INQPID")) Q 1
  1. ; Look up on patient name. If unique patient identified, set
  1. ; INQA("INQPID")=IEN.
  1. S INXV=$G(@INV@("QRD8.2"))_","_$G(@INV@("QRD8.3"))_$S($L(@INV@("QRD8.4")):" "_@INV@("QRD8.4"),1:"")
  1. I $L(INXV)>1 S INQA("INQPID")=$$GETPAT(INXV) I $G(INQA("INQPID")) Q 1
  1. ; Else,
  1. ; Abort processing with error, "No Unique Patient Identified." Quit.
  1. ; (Application error will be transmitted in MSA-6 of application ack)
  1. Q 0
  1. ;
  1. WHAT() ; Get category for processing.
  1. ; Get WHAT SUBJECT FILTER from INV array (INV("QRD9"))
  1. S INXV=$G(@INV@("QRD9")) S:$L(INXV) (INQA("INQCAT"),INOA("INQWHAT"))=INXV
  1. I ",DEM,ORD,RES,SBK,"'[(","_INXV_",") K INQA("INQCAT")
  1. ; Valid values:
  1. ; DEM - Patient Demograpic data
  1. ; ORD - Order data
  1. ; RES - Results data
  1. ; SBK - Booked slots on the identified schedule
  1. ;
  1. ; Get subclassification for processing.
  1. ; Get WHERE SUBJECT FILTER from INV array (INV("QRF1"))
  1. S INXV=$G(@INV@("QRF1"))
  1. ;
  1. ; Valid values (based on WHAT SUBJECT FILTER):
  1. ; (* indicates default if WHERE SUBJECT FILTER not defined)
  1. ;
  1. ; WHAT WHERE
  1. ; ---- -----
  1. ; DEM *PID (patient demographics only)
  1. ; ALG (allergy data)
  1. ; ORD *PHR (medication profile)
  1. ; PHR/RX (prescriptions only)
  1. ; RES *LAB (all laboratory results)
  1. ; LAB/AP (anatomic pathology results only)
  1. ; LAB/BB (blood bank results only)
  1. ; LAB/CH (chemistry results only)
  1. ; LAB/MI (microbiology results only)
  1. ; RAD (all radiology results)
  1. ; SBK *SBK (booked slots on the identified schedule)
  1. ;
  1. ; *** NOTE: WHERE SUBJECT FILTER takes precedence over WHAT SUBJECT
  1. ; FILTER. If WHERE defined, reset CATEGORY to correspond.
  1. ; If valid value in WHERE SUBJECT FILTER, set INQA("INQCAT")=category.
  1. ; Go to WHEN.
  1. ;
  1. I ",PID,ALG,PHR,PHR/RX,LAB,LAB/AP,LAB/BB,LAB/CH,LAB/MI,RAD,SBK,"[(","_INXV_",") S INQA("INQCAT")=INXV Q 1
  1. ;
  1. ; If valid value in WHAT SUBJECT FILTER, set INQA("INQCAT")=default
  1. ; for WHAT SUBJECT FILTER. Go to WHEN
  1. I $D(INQA("INQCAT")) S INXV=INQA("INQCAT") D
  1. .I INXV="DEM" S INQA("INQCAT")="PID" Q
  1. .I INXV="ORD" S INQA("INQCAT")="PHR" Q
  1. .I INXV="RES" S INQA("INQCAT")="LAB" Q
  1. .I INXV="SBK" S INQA("INQCAT")="SBK" Q
  1. .K INQA("INQCAT")
  1. Q:$D(INQA("INQCAT")) 1
  1. ;
  1. ; Else,
  1. ; Abort processing with error, "No category defined" and quit.
  1. ; (Application error will be transmitted in MSA-6 of application ack)
  1. Q 0
  1. ;
  1. WHEN ; Determine start and end dates.
  1. ; Get WHEN QTY/TIMING QUAL from INV array (INV("QRF9"))
  1. ; Sub-components:
  1. ; 4 - Start date/time
  1. ; 5 - End date/time
  1. ; Start date/time not required. Will default to T-(1 month). Derive
  1. ; FileMan date/time. Set INQA("INQFRM")=fileman start date.
  1. S INXV=$G(@INV@("QRF9.4"))\1 I 'INXV S INXV=$$ADDM^%ZTFDT($$DT^%ZTFDT,-1)
  1. S INQA("INQFRM")=INXV
  1. ; End date/time not required. Will default to current date. Derive
  1. ; FileMan date/time. Set INQA("INQTHRU")=fileman end date.
  1. ;
  1. ; *** NOTE: The end date will be sent to the application routine.
  1. ; No time is sent. The application routine should include
  1. ; all responses for the date equal to the end date.
  1. S INXV=$G(@INV@("QRF9.5"))\1 I 'INXV S INXV=$$DT^%ZTFDT
  1. S INQA("INQTHRU")=INXV
  1. ; Get WHICH value. If not defined, set default.
  1. ; Valid Values:
  1. ; ALG and PHR will only support ORD - Order Date/Time
  1. ; PID is not date sensitive data
  1. ; RAD and LAB will support COL (Collection/Exam Date/Time),
  1. ; REP (Report/Certify Date/Time), and
  1. ; ORD (Order Start Date/Time)
  1. ; SBK will support SCHED (Schedule Date/Time)
  1. ;
  1. ; Default Values:
  1. ; Category Which Date Value
  1. ; -------- ----------------
  1. ; ALG,PHR ORD - Order Date/Time
  1. ; LAB,RAD REP - Report/Certify Date/Time
  1. ; PID Not Linked to a dated field
  1. ; SBK SCHED - Schedule Date/Time
  1. ;
  1. S INQA("INQWHICH")=$G(@INV@("QRF6"))
  1. I ",ORD,COL,REP,SCHED,"'[(","_INQA("INQWHICH")_",") S INQA("INQWHICH")=""
  1. I '$L(INQA("INQWHICH")) S INXV=$G(INQA("INQCAT")),INQA("INQWHICH")=$S("LABRAD"[$P(INXV,"/"):"REP","SBK":"SCHED",1:"ORD")
  1. Q
  1. ;
  1. MISC ; Set INDEST and Original Message (Query) message ID for processing.
  1. ; Set INOA("INDEST")=query destination
  1. ; Set INOA("INSTAT")=application accept
  1. ;
  1. S INOA("INMIDGEN")=$P($G(^INTHU(UIF,0)),U,5)
  1. S INOA("INDEST")=$P($G(^INTHU(UIF,2)),U,2)
  1. S INOA("INSTAT")="AA"
  1. ;
  1. ; Set QRD values into INOA array for return in responses.
  1. S INOA("INQDTM")=$G(@INV@("QRD1"))
  1. S INOA("INQPRI")="D"
  1. S INOA("INQTAG")=$G(@INV@("QRD4"))
  1. S INOA("INQWHO")=$G(@INV@("QRD8"))
  1. S INOA("INQWHAT")=$G(@INV@("QRD9"))
  1. ;
  1. ; Get routine for processing.
  1. S INQAPPL=$P($T(@$P(INQA("INQCAT"),"/")),";",3)
  1. ;
  1. ; Call routine, passing in INOA, and INQA arrays.
  1. ; Will return number of responses in INOA array for application
  1. ; ACK processing.
  1. S @("INOA(""INQRSP"")=$$"_INQAPPL_"(.INOA,.INQA)")
  1. ;
  1. ; Set variables for application ack
  1. ; Quit Lookup/Store routine.
  1. S INOA("INQRSTAT")=$S(INOA("INQRSP"):"OK",1:"NF")
  1. Q
  1. ;
  1. GETPAT(INXV) ; Get CHCS patient IEN
  1. ; Initialize variables for FileMan Lookup
  1. N X,Y,DIC
  1. ; If FMP/SSN or name search, perform lookup. If unique patient found,
  1. ; quit with CHCS patient IEN. Function returns CHCS Patient IEN
  1. ; in Y(1) if found.
  1. S INXV=$TR(INXV,"-","")
  1. S DIC=2,X=INXV,DIC(0)="MSX"
  1. D ^DIC
  1. ;
  1. ; If no unique patient found, quit with 0 to continue processing error.
  1. I '$G(Y(1)) Q 0
  1. ; Else,
  1. ; Quit with IEN of unique CHCS patient.
  1. Q +Y(1)
  1. ;
  1. LOGERR(E) ; Log error message E. Set values for ack error.
  1. ; Quit Lookup/Store routine.
  1. ;
  1. S INOA("INSTAT")="AE"
  1. S INOA("INORIGID")=$G(@INV@("MSH10"))
  1. S INODA=""
  1. D ERROR^INHS(E,2)
  1. Q
  1. ;
  1. PID ;;PID^DGGISQ
  1. ALG ;;ALG^ORGISQR
  1. PHR ;;PHR^ORGISQR
  1. RAD ;;RAD^RAGISQ
  1. LAB ;;LAB^LRGISQ
  1. SBK ;;SBK^SDGISQ