source: WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHVRQI.m@ 613

Last change on this file since 613 was 613, checked in by George Lilly, 14 years ago

initial load of WorldVistAEHR
File size: 3.0 KB
Line 
1MHVRQI ;WAS/GPM - Request Manager Immediate Mode ; 7/28/05 11:49pm [12/14/06 11:38am]
2 ;;1.0;My HealtheVet;**2**;Aug 23, 2005;Build 22
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ;
6REALTIME(REQ,XMT,HL) ; Manage immediate mode / real time requests
7 ;
8 ; Triage, execute/extract and respond to real time requests and
9 ; queries. If the request is rejected (blocked, or doesn't support
10 ; real time access), send a negative acknowledgement, otherwise call
11 ; the execute/extraction routine. If there are no errors transmit
12 ; the results, send a negative acknowledgement if there are errors.
13 ;
14 ; Input:
15 ; REQ - Parsed query and query parameters
16 ; XMT - Transmission parameters
17 ; HL - HL7 package array variable
18 ;
19 ; Output:
20 ; Extract information and respond to query
21 ;
22 N ERR,DATAROOT,MHVDATA
23 S DATAROOT="^TMP(""MHVEXTRACT"","_$J_","_REQ("TYPE")_")"
24 S ERR=""
25 ;
26 D LOG^MHVUL2("REQUEST MGR - IMMEDIATE","BEGIN","S","TRACE")
27 ;
28 I $$REJECT(.REQ,.ERR) D Q
29 . D LOG^MHVUL2("REQUEST CHECK","REJECT^"_ERR,"S","ERROR")
30 . D XMIT^MHV7T(.REQ,.XMT,ERR,"",.HL)
31 D LOG^MHVUL2("REQUEST CHECK","PROCESS","S","TRACE")
32 ;
33 I '$$EXECUTE(.REQ,.ERR,.DATAROOT) D Q
34 . D LOG^MHVUL2("REQUEST EXECUTE","ERROR^"_ERR,"S","ERROR")
35 . D XMIT^MHV7T(.REQ,.XMT,ERR,DATAROOT,.HL)
36 D LOG^MHVUL2("REQUEST EXECUTE","COMPLETE","S","TRACE")
37 ;
38 D XMIT^MHV7T(.REQ,.XMT,ERR,DATAROOT,.HL)
39 K @DATAROOT
40 ;
41 D LOG^MHVUL2("REQUEST MGR - IMMEDIATE","END","S","TRACE")
42 ;
43 Q
44 ;
45REJECT(REQ,ERR) ;Check to see if request can be processed
46 S ERR=""
47 I REQ("BLOCKED") D Q 1
48 . S ERR="^207^AR^Request Type Blocked by Site"
49 . I $D(REQ("QPD")) S ERR="QPD^1^4"_ERR Q ;QBP query flag the QPD
50 . I $D(REQ("QRD")) S ERR="QRD^1^10"_ERR Q ;old style query flag QRD
51 . S ERR="MSH^1^9"_ERR ;not a query flag MSH
52 . Q
53 I 'REQ("REALTIME") D Q 1
54 . S ERR="^207^AR^Real Time Calls Not Supported By Request Type"
55 . I $D(REQ("QPD")) S ERR="RCP^1^1"_ERR Q ;QBP query flag RCP
56 . I $D(REQ("QRD")) S ERR="QRD^1^3"_ERR Q ;old style query flag QRD
57 . S ERR="MSH^1^9"_ERR ;not a query flag MSH
58 . Q
59 Q 0
60 ;
61EXECUTE(REQ,ERR,DATAROOT) ;Execute action or extraction
62 ;Calls the execute routine for this request type
63 ;For queries this is the extraction routine
64 ;Parameters can be passed on REQ
65 ;Errors are passed on ERR
66 ;
67 ; DATAROOT is passed by reference because extractors are permitted
68 ; to change the root referenced. This allows on the fly use of
69 ; local variables and globals produced by calls to other packages.
70 ; Care must be given when using locals because they cannot be NEWed.
71 ; MHVDATA is NEWed above, and can be safely used.
72 ; The KILL in the main loop above will clean up.
73 ;
74 S ERR=""
75 D @(REQ("EXECUTE")_"(.REQ,.ERR,.DATAROOT)")
76 I ERR D Q 0
77 . S ERR="^207^AR^"_$P(ERR,"^",2)
78 . I $D(REQ("QPD")) S ERR="QPD^1^4"_ERR Q ;QBP query flag the QPD
79 . I $D(REQ("QRD")) S ERR="QRD^1^10"_ERR Q ;old style query flag QRD
80 . S ERR="MSH^1^9"_ERR ;not a query flag MSH
81 . Q
82 Q 1
83 ;
Note: See TracBrowser for help on using the repository browser.