source: WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7R2.m@ 619

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

initial load of WorldVistAEHR
File size: 4.7 KB
Line 
1MHV7R2 ;WAS/GPM - HL7 RECEIVER FOR OMP^O09 ; [12/31/07 10:38am]
2 ;;1.0;My HealtheVet;**1,2**;Aug 23, 2005;Build 22
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5OMPO09 ;Process OMP^O09 messages from the MHV OMP^O09 Subscriber protocol
6 ;
7 ; This routine and subroutines assume that all VistA HL7 environment
8 ; variables are properly initialized and will produce a fatal error
9 ; if they are missing.
10 ;
11 ; The message will be checked to see if it is a valid OMP^O09 order
12 ; message. If not, a negative acknowledgement will be sent. The
13 ; realtime request manager is called to handle all order messages.
14 ; This means the order will be processed and a response generated
15 ; immediately whether the message is synchronous or asynchronous.
16 ;
17 ; Input:
18 ; HL7 environment variables
19 ;
20 ; Output:
21 ; Processed query or negative acknowledgement
22 ;
23 N MSGROOT,REQ,XMT,ERR
24 S (REQ,XMT,ERR)=""
25 ; Inbound order messages are small enough to be held in a local.
26 ; The following lines commented out support use of global and are
27 ; left in case use a global becomes necessary.
28 ;S MSGROOT="^TMP(""MHV7"",$J)"
29 ;K @MSGROOT
30 S MSGROOT="MHV7MSG"
31 N MHV7MSG
32 D LOADXMT^MHV7U(.XMT) ;Load inbound message information
33 D LOG^MHVUL2("OMP-O09 RECEIVER","BEGIN","S","TRACE")
34 ;
35 D LOADMSG^MHV7U(MSGROOT)
36 D LOG^MHVUL2("LOAD",MSGROOT,"I","DEBUG")
37 ;
38 D PARSEMSG^MHV7U(MSGROOT,.HL)
39 D LOG^MHVUL2("PARSE",MSGROOT,"I","DEBUG")
40 ;
41 I '$$VALIDMSG(MSGROOT,.REQ,.XMT,.ERR) D Q
42 . D LOG^MHVUL2("MSG CHECK","INVALID^"_ERR,"S","ERROR")
43 . D XMIT^MHV7T(.REQ,.XMT,ERR,"",.HL)
44 D LOG^MHVUL2("MSG CHECK","VALID","S","TRACE")
45 ;
46 D REALTIME^MHVRQI(.REQ,.XMT,.HL)
47 ;
48 D LOG^MHVUL2("OMP-O09 RECEIVER","END","S","TRACE")
49 D RESET^MHVUL2 ;Clean up TMP used by logging
50 ;K @MSGROOT
51 ;
52 Q
53 ;
54VALIDMSG(MSGROOT,REQ,XMT,ERR) ;Validate message
55 ;
56 ; OMP^O09 messages must contain PID, ORC, and RXE segments
57 ;
58 ; The following sequences are required
59 ; PID(3) - ICN/DFN
60 ; ORC(2) - Placer Order Number
61 ; RXE(1).4- Order Start Time
62 ; RXE(15) - Prescription Number
63 ;
64 ; The following sequences are optional
65 ;
66 ; ERR = segment^sequence^field^code^ACK type^error text
67 ;
68 ; Input:
69 ; MSGROOT - Root of array holding message
70 ; XMT - Transmission parameters
71 ;
72 ; Output:
73 ; REQ - Request Array
74 ; XMT - Transmission parameters
75 ; ERR - segment^sequence^field^code^ACK type^error text
76 ;
77 N MSH,PID,ORC,RXE,CNT,REQTYPE,I,ORDERCTL,PORDERN,ORDERQTY,GIVEID,GIVESYS,GIVEAMT,GIVEUNT,ORDERTM,RXNUM
78 K REQ,ERR
79 S ERR=""
80 ;
81 ; Set up message ID for responding to message.
82 ;---------------------------------------------
83 S REQ("MID")=XMT("MID") ;Message ID
84 ;
85 ; Validate message is a well-formed OMP^O09 message
86 ;-----------------------------------------------------------
87 ; Must have MSH first followed by PID, then one or more ORC/RXE pairs
88 ;
89 I $G(@MSGROOT@(1,0))="MSH" M MSH=@MSGROOT@(1)
90 E S ERR="MSH^1^^100^AE^Missing MSH segment" Q 0
91 ;
92 I $G(@MSGROOT@(2,0))="PID" M PID=@MSGROOT@(2),REQ("PID")=PID
93 E S ERR="PID^1^^100^AE^Missing PID segment" Q 0
94 ;
95 S CNT=3
96 F Q:'$D(@MSGROOT@(CNT)) D Q:ERR'=""
97 . I $G(@MSGROOT@(CNT,0))="ORC" M ORC(CNT\2)=@MSGROOT@(CNT)
98 . E S ERR="ORC^1^^100^AE^Missing ORC segment" Q
99 . I $G(@MSGROOT@(CNT+1,0))="RXE" M RXE(CNT\2)=@MSGROOT@(CNT+1)
100 . E S ERR="RXE^1^^100^AE^Missing RXE segment" Q
101 . S CNT=CNT+2
102 . Q
103 Q:ERR'="" 0
104 ;
105 I '$D(ORC) S ERR="ORC^1^^100^AE^Missing ORC segment" Q 0
106 I '$D(RXE) S ERR="RXE^1^^100^AE^Missing RXE segment" Q 0
107 ;
108 ;
109 ; Validate required fields and refill request parameters
110 ;-----------------------------------------------------------
111 ;
112 I '$$VALIDPID^MHV7RUS(.PID,.REQ,.ERR) Q 0
113 ;
114 F I=1:1 Q:'$D(ORC(I)) D Q:ERR'=""
115 . S ORDERCTL=$G(ORC(I,1))
116 . S PORDERN=$G(ORC(I,2))
117 . I ORDERCTL="" S ERR="ORC^"_I_"^2^101^AE^Missing Order Control" Q
118 . I PORDERN="" S ERR="ORC^"_I_"^2^101^AE^Missing Placer Order#" Q
119 . ;
120 . S ORDERQTY=$G(RXE(I,1,1,1))
121 . S ORDERTM=$G(RXE(I,1,1,4))
122 . S GIVEID=$G(RXE(I,2,1,1))
123 . S GIVESYS=$G(RXE(I,2,1,3))
124 . S GIVEAMT=$G(RXE(I,3))
125 . S GIVEUNT=$G(RXE(I,5))
126 . S RXNUM=$G(RXE(I,15))
127 . I ORDERQTY="" S ERR="RXE^"_I_"^1^101^AE^Missing Order Quantity" Q
128 . I ORDERTM="" S ERR="RXE^"_I_"^1^101^AE^Missing Order Start Time" Q
129 . I GIVEID="" S ERR="RXE^"_I_"^2^101^AE^Missign Give Code ID" Q
130 . I GIVESYS="" S ERR="RXE^"_I_"^2^101^AE^Missing Give Code System" Q
131 . I GIVEAMT="" S ERR="RXE^"_I_"^3^101^AE^Missing Give Amount" Q
132 . I GIVEUNT="" S ERR="RXE^"_I_"^5^101^AE^Missing Give Units" Q
133 . I RXNUM="" S ERR="RXE^"_I_"^15^101^AE^Missing Prescription#" Q
134 . I RXNUM'?1N.N0.1A S ERR="RXE^"_I_"^15^102^AE^Invalid Prescription#" Q
135 . S REQ("RX",I)=RXNUM_"^"_PORDERN_"^"_ORDERTM
136 . Q
137 Q:ERR'="" 0
138 ;
139 I '$$VALRTYPE^MHV7RU("RxRefill",.REQ,.ERR) S ERR="MSH^1^9^"_ERR Q 0
140 ;
141 Q 1
142 ;
Note: See TracBrowser for help on using the repository browser.