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