MHVRQI ;WAS/GPM - Request Manager Immediate Mode ; 7/28/05 11:49pm [12/14/06 11:38am]
;;1.0;My HealtheVet;**2**;Aug 23, 2005;Build 22
;;Per VHA Directive 2004-038, this routine should not be modified.
;
;
REALTIME(REQ,XMT,HL) ; Manage immediate mode / real time requests
;
; Triage, execute/extract and respond to real time requests and
; queries. If the request is rejected (blocked, or doesn't support
; real time access), send a negative acknowledgement, otherwise call
; the execute/extraction routine. If there are no errors transmit
; the results, send a negative acknowledgement if there are errors.
;
; Input:
; REQ - Parsed query and query parameters
; XMT - Transmission parameters
; HL - HL7 package array variable
;
; Output:
; Extract information and respond to query
;
N ERR,DATAROOT,MHVDATA
S DATAROOT="^TMP(""MHVEXTRACT"","_$J_","_REQ("TYPE")_")"
S ERR=""
;
D LOG^MHVUL2("REQUEST MGR - IMMEDIATE","BEGIN","S","TRACE")
;
I $$REJECT(.REQ,.ERR) D Q
. D LOG^MHVUL2("REQUEST CHECK","REJECT^"_ERR,"S","ERROR")
. D XMIT^MHV7T(.REQ,.XMT,ERR,"",.HL)
D LOG^MHVUL2("REQUEST CHECK","PROCESS","S","TRACE")
;
I '$$EXECUTE(.REQ,.ERR,.DATAROOT) D Q
. D LOG^MHVUL2("REQUEST EXECUTE","ERROR^"_ERR,"S","ERROR")
. D XMIT^MHV7T(.REQ,.XMT,ERR,DATAROOT,.HL)
D LOG^MHVUL2("REQUEST EXECUTE","COMPLETE","S","TRACE")
;
D XMIT^MHV7T(.REQ,.XMT,ERR,DATAROOT,.HL)
K @DATAROOT
;
D LOG^MHVUL2("REQUEST MGR - IMMEDIATE","END","S","TRACE")
;
Q
;
REJECT(REQ,ERR) ;Check to see if request can be processed
S ERR=""
I REQ("BLOCKED") D Q 1
. S ERR="^207^AR^Request Type Blocked by Site"
. I $D(REQ("QPD")) S ERR="QPD^1^4"_ERR Q ;QBP query flag the QPD
. I $D(REQ("QRD")) S ERR="QRD^1^10"_ERR Q ;old style query flag QRD
. S ERR="MSH^1^9"_ERR ;not a query flag MSH
. Q
I 'REQ("REALTIME") D Q 1
. S ERR="^207^AR^Real Time Calls Not Supported By Request Type"
. I $D(REQ("QPD")) S ERR="RCP^1^1"_ERR Q ;QBP query flag RCP
. I $D(REQ("QRD")) S ERR="QRD^1^3"_ERR Q ;old style query flag QRD
. S ERR="MSH^1^9"_ERR ;not a query flag MSH
. Q
Q 0
;
EXECUTE(REQ,ERR,DATAROOT) ;Execute action or extraction
;Calls the execute routine for this request type
;For queries this is the extraction routine
;Parameters can be passed on REQ
;Errors are passed on ERR
;
; DATAROOT is passed by reference because extractors are permitted
; to change the root referenced. This allows on the fly use of
; local variables and globals produced by calls to other packages.
; Care must be given when using locals because they cannot be NEWed.
; MHVDATA is NEWed above, and can be safely used.
; The KILL in the main loop above will clean up.
;
S ERR=""
D @(REQ("EXECUTE")_"(.REQ,.ERR,.DATAROOT)")
I ERR D Q 0
. S ERR="^207^AR^"_$P(ERR,"^",2)
. I $D(REQ("QPD")) S ERR="QPD^1^4"_ERR Q ;QBP query flag the QPD
. I $D(REQ("QRD")) S ERR="QRD^1^10"_ERR Q ;old style query flag QRD
. S ERR="MSH^1^9"_ERR ;not a query flag MSH
. Q
Q 1
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMHVRQI 3152 printed Apr 09, 2024@21:17:22 Page 2
MHVRQI ;WAS/GPM - Request Manager Immediate Mode ; 7/28/05 11:49pm [12/14/06 11:38am]
+1 ;;1.0;My HealtheVet;**2**;Aug 23, 2005;Build 22
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;
REALTIME(REQ,XMT,HL) ; Manage immediate mode / real time requests
+1 ;
+2 ; Triage, execute/extract and respond to real time requests and
+3 ; queries. If the request is rejected (blocked, or doesn't support
+4 ; real time access), send a negative acknowledgement, otherwise call
+5 ; the execute/extraction routine. If there are no errors transmit
+6 ; the results, send a negative acknowledgement if there are errors.
+7 ;
+8 ; Input:
+9 ; REQ - Parsed query and query parameters
+10 ; XMT - Transmission parameters
+11 ; HL - HL7 package array variable
+12 ;
+13 ; Output:
+14 ; Extract information and respond to query
+15 ;
+16 NEW ERR,DATAROOT,MHVDATA
+17 SET DATAROOT="^TMP(""MHVEXTRACT"","_$JOB_","_REQ("TYPE")_")"
+18 SET ERR=""
+19 ;
+20 DO LOG^MHVUL2("REQUEST MGR - IMMEDIATE","BEGIN","S","TRACE")
+21 ;
+22 IF $$REJECT(.REQ,.ERR)
Begin DoDot:1
+23 DO LOG^MHVUL2("REQUEST CHECK","REJECT^"_ERR,"S","ERROR")
+24 DO XMIT^MHV7T(.REQ,.XMT,ERR,"",.HL)
End DoDot:1
QUIT
+25 DO LOG^MHVUL2("REQUEST CHECK","PROCESS","S","TRACE")
+26 ;
+27 IF '$$EXECUTE(.REQ,.ERR,.DATAROOT)
Begin DoDot:1
+28 DO LOG^MHVUL2("REQUEST EXECUTE","ERROR^"_ERR,"S","ERROR")
+29 DO XMIT^MHV7T(.REQ,.XMT,ERR,DATAROOT,.HL)
End DoDot:1
QUIT
+30 DO LOG^MHVUL2("REQUEST EXECUTE","COMPLETE","S","TRACE")
+31 ;
+32 DO XMIT^MHV7T(.REQ,.XMT,ERR,DATAROOT,.HL)
+33 KILL @DATAROOT
+34 ;
+35 DO LOG^MHVUL2("REQUEST MGR - IMMEDIATE","END","S","TRACE")
+36 ;
+37 QUIT
+38 ;
REJECT(REQ,ERR) ;Check to see if request can be processed
+1 SET ERR=""
+2 IF REQ("BLOCKED")
Begin DoDot:1
+3 SET ERR="^207^AR^Request Type Blocked by Site"
+4 ;QBP query flag the QPD
IF $DATA(REQ("QPD"))
SET ERR="QPD^1^4"_ERR
QUIT
+5 ;old style query flag QRD
IF $DATA(REQ("QRD"))
SET ERR="QRD^1^10"_ERR
QUIT
+6 ;not a query flag MSH
SET ERR="MSH^1^9"_ERR
+7 QUIT
End DoDot:1
QUIT 1
+8 IF 'REQ("REALTIME")
Begin DoDot:1
+9 SET ERR="^207^AR^Real Time Calls Not Supported By Request Type"
+10 ;QBP query flag RCP
IF $DATA(REQ("QPD"))
SET ERR="RCP^1^1"_ERR
QUIT
+11 ;old style query flag QRD
IF $DATA(REQ("QRD"))
SET ERR="QRD^1^3"_ERR
QUIT
+12 ;not a query flag MSH
SET ERR="MSH^1^9"_ERR
+13 QUIT
End DoDot:1
QUIT 1
+14 QUIT 0
+15 ;
EXECUTE(REQ,ERR,DATAROOT) ;Execute action or extraction
+1 ;Calls the execute routine for this request type
+2 ;For queries this is the extraction routine
+3 ;Parameters can be passed on REQ
+4 ;Errors are passed on ERR
+5 ;
+6 ; DATAROOT is passed by reference because extractors are permitted
+7 ; to change the root referenced. This allows on the fly use of
+8 ; local variables and globals produced by calls to other packages.
+9 ; Care must be given when using locals because they cannot be NEWed.
+10 ; MHVDATA is NEWed above, and can be safely used.
+11 ; The KILL in the main loop above will clean up.
+12 ;
+13 SET ERR=""
+14 DO @(REQ("EXECUTE")_"(.REQ,.ERR,.DATAROOT)")
+15 IF ERR
Begin DoDot:1
+16 SET ERR="^207^AR^"_$PIECE(ERR,"^",2)
+17 ;QBP query flag the QPD
IF $DATA(REQ("QPD"))
SET ERR="QPD^1^4"_ERR
QUIT
+18 ;old style query flag QRD
IF $DATA(REQ("QRD"))
SET ERR="QRD^1^10"_ERR
QUIT
+19 ;not a query flag MSH
SET ERR="MSH^1^9"_ERR
+20 QUIT
End DoDot:1
QUIT 0
+21 QUIT 1
+22 ;
