MHV7R2 ;WAS/GPM - HL7 RECEIVER FOR OMP^O09 ; [12/31/07 10:38am]
;;1.0;My HealtheVet;**1,2**;Aug 23, 2005;Build 22
;;Per VHA Directive 2004-038, this routine should not be modified.
;
OMPO09 ;Process OMP^O09 messages from the MHV OMP^O09 Subscriber protocol
;
; This routine and subroutines assume that all VistA HL7 environment
; variables are properly initialized and will produce a fatal error
; if they are missing.
;
; The message will be checked to see if it is a valid OMP^O09 order
; message. If not, a negative acknowledgement will be sent. The
; realtime request manager is called to handle all order messages.
; This means the order will be processed and a response generated
; immediately whether the message is synchronous or asynchronous.
;
; Input:
; HL7 environment variables
;
; Output:
; Processed query or negative acknowledgement
;
N MSGROOT,REQ,XMT,ERR
S (REQ,XMT,ERR)=""
; Inbound order messages are small enough to be held in a local.
; The following lines commented out support use of global and are
; left in case use a global becomes necessary.
;S MSGROOT="^TMP(""MHV7"",$J)"
;K @MSGROOT
S MSGROOT="MHV7MSG"
N MHV7MSG
D LOADXMT^MHV7U(.XMT) ;Load inbound message information
D LOG^MHVUL2("OMP-O09 RECEIVER","BEGIN","S","TRACE")
;
D LOADMSG^MHV7U(MSGROOT)
D LOG^MHVUL2("LOAD",MSGROOT,"I","DEBUG")
;
D PARSEMSG^MHV7U(MSGROOT,.HL)
D LOG^MHVUL2("PARSE",MSGROOT,"I","DEBUG")
;
I '$$VALIDMSG(MSGROOT,.REQ,.XMT,.ERR) D Q
. D LOG^MHVUL2("MSG CHECK","INVALID^"_ERR,"S","ERROR")
. D XMIT^MHV7T(.REQ,.XMT,ERR,"",.HL)
D LOG^MHVUL2("MSG CHECK","VALID","S","TRACE")
;
D REALTIME^MHVRQI(.REQ,.XMT,.HL)
;
D LOG^MHVUL2("OMP-O09 RECEIVER","END","S","TRACE")
D RESET^MHVUL2 ;Clean up TMP used by logging
;K @MSGROOT
;
Q
;
VALIDMSG(MSGROOT,REQ,XMT,ERR) ;Validate message
;
; OMP^O09 messages must contain PID, ORC, and RXE segments
;
; The following sequences are required
; PID(3) - ICN/DFN
; ORC(2) - Placer Order Number
; RXE(1).4- Order Start Time
; RXE(15) - Prescription Number
;
; The following sequences are optional
;
; ERR = segment^sequence^field^code^ACK type^error text
;
; Input:
; MSGROOT - Root of array holding message
; XMT - Transmission parameters
;
; Output:
; REQ - Request Array
; XMT - Transmission parameters
; ERR - segment^sequence^field^code^ACK type^error text
;
N MSH,PID,ORC,RXE,CNT,REQTYPE,I,ORDERCTL,PORDERN,ORDERQTY,GIVEID,GIVESYS,GIVEAMT,GIVEUNT,ORDERTM,RXNUM
K REQ,ERR
S ERR=""
;
; Set up message ID for responding to message.
;---------------------------------------------
S REQ("MID")=XMT("MID") ;Message ID
;
; Validate message is a well-formed OMP^O09 message
;-----------------------------------------------------------
; Must have MSH first followed by PID, then one or more ORC/RXE pairs
;
I $G(@MSGROOT@(1,0))="MSH" M MSH=@MSGROOT@(1)
E S ERR="MSH^1^^100^AE^Missing MSH segment" Q 0
;
I $G(@MSGROOT@(2,0))="PID" M PID=@MSGROOT@(2),REQ("PID")=PID
E S ERR="PID^1^^100^AE^Missing PID segment" Q 0
;
S CNT=3
F Q:'$D(@MSGROOT@(CNT)) D Q:ERR'=""
. I $G(@MSGROOT@(CNT,0))="ORC" M ORC(CNT\2)=@MSGROOT@(CNT)
. E S ERR="ORC^1^^100^AE^Missing ORC segment" Q
. I $G(@MSGROOT@(CNT+1,0))="RXE" M RXE(CNT\2)=@MSGROOT@(CNT+1)
. E S ERR="RXE^1^^100^AE^Missing RXE segment" Q
. S CNT=CNT+2
. Q
Q:ERR'="" 0
;
I '$D(ORC) S ERR="ORC^1^^100^AE^Missing ORC segment" Q 0
I '$D(RXE) S ERR="RXE^1^^100^AE^Missing RXE segment" Q 0
;
;
; Validate required fields and refill request parameters
;-----------------------------------------------------------
;
I '$$VALIDPID^MHV7RUS(.PID,.REQ,.ERR) Q 0
;
F I=1:1 Q:'$D(ORC(I)) D Q:ERR'=""
. S ORDERCTL=$G(ORC(I,1))
. S PORDERN=$G(ORC(I,2))
. I ORDERCTL="" S ERR="ORC^"_I_"^2^101^AE^Missing Order Control" Q
. I PORDERN="" S ERR="ORC^"_I_"^2^101^AE^Missing Placer Order#" Q
. ;
. S ORDERQTY=$G(RXE(I,1,1,1))
. S ORDERTM=$G(RXE(I,1,1,4))
. S GIVEID=$G(RXE(I,2,1,1))
. S GIVESYS=$G(RXE(I,2,1,3))
. S GIVEAMT=$G(RXE(I,3))
. S GIVEUNT=$G(RXE(I,5))
. S RXNUM=$G(RXE(I,15))
. I ORDERQTY="" S ERR="RXE^"_I_"^1^101^AE^Missing Order Quantity" Q
. I ORDERTM="" S ERR="RXE^"_I_"^1^101^AE^Missing Order Start Time" Q
. I GIVEID="" S ERR="RXE^"_I_"^2^101^AE^Missign Give Code ID" Q
. I GIVESYS="" S ERR="RXE^"_I_"^2^101^AE^Missing Give Code System" Q
. I GIVEAMT="" S ERR="RXE^"_I_"^3^101^AE^Missing Give Amount" Q
. I GIVEUNT="" S ERR="RXE^"_I_"^5^101^AE^Missing Give Units" Q
. I RXNUM="" S ERR="RXE^"_I_"^15^101^AE^Missing Prescription#" Q
. I RXNUM'?1N.N0.1A S ERR="RXE^"_I_"^15^102^AE^Invalid Prescription#" Q
. S REQ("RX",I)=RXNUM_"^"_PORDERN_"^"_ORDERTM
. Q
Q:ERR'="" 0
;
I '$$VALRTYPE^MHV7RU("RxRefill",.REQ,.ERR) S ERR="MSH^1^9^"_ERR Q 0
;
Q 1
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMHV7R2 4997 printed Dec 13, 2024@02:15:55 Page 2
MHV7R2 ;WAS/GPM - HL7 RECEIVER FOR OMP^O09 ; [12/31/07 10:38am]
+1 ;;1.0;My HealtheVet;**1,2**;Aug 23, 2005;Build 22
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
OMPO09 ;Process OMP^O09 messages from the MHV OMP^O09 Subscriber protocol
+1 ;
+2 ; This routine and subroutines assume that all VistA HL7 environment
+3 ; variables are properly initialized and will produce a fatal error
+4 ; if they are missing.
+5 ;
+6 ; The message will be checked to see if it is a valid OMP^O09 order
+7 ; message. If not, a negative acknowledgement will be sent. The
+8 ; realtime request manager is called to handle all order messages.
+9 ; This means the order will be processed and a response generated
+10 ; immediately whether the message is synchronous or asynchronous.
+11 ;
+12 ; Input:
+13 ; HL7 environment variables
+14 ;
+15 ; Output:
+16 ; Processed query or negative acknowledgement
+17 ;
+18 NEW MSGROOT,REQ,XMT,ERR
+19 SET (REQ,XMT,ERR)=""
+20 ; Inbound order messages are small enough to be held in a local.
+21 ; The following lines commented out support use of global and are
+22 ; left in case use a global becomes necessary.
+23 ;S MSGROOT="^TMP(""MHV7"",$J)"
+24 ;K @MSGROOT
+25 SET MSGROOT="MHV7MSG"
+26 NEW MHV7MSG
+27 ;Load inbound message information
DO LOADXMT^MHV7U(.XMT)
+28 DO LOG^MHVUL2("OMP-O09 RECEIVER","BEGIN","S","TRACE")
+29 ;
+30 DO LOADMSG^MHV7U(MSGROOT)
+31 DO LOG^MHVUL2("LOAD",MSGROOT,"I","DEBUG")
+32 ;
+33 DO PARSEMSG^MHV7U(MSGROOT,.HL)
+34 DO LOG^MHVUL2("PARSE",MSGROOT,"I","DEBUG")
+35 ;
+36 IF '$$VALIDMSG(MSGROOT,.REQ,.XMT,.ERR)
Begin DoDot:1
+37 DO LOG^MHVUL2("MSG CHECK","INVALID^"_ERR,"S","ERROR")
+38 DO XMIT^MHV7T(.REQ,.XMT,ERR,"",.HL)
End DoDot:1
QUIT
+39 DO LOG^MHVUL2("MSG CHECK","VALID","S","TRACE")
+40 ;
+41 DO REALTIME^MHVRQI(.REQ,.XMT,.HL)
+42 ;
+43 DO LOG^MHVUL2("OMP-O09 RECEIVER","END","S","TRACE")
+44 ;Clean up TMP used by logging
DO RESET^MHVUL2
+45 ;K @MSGROOT
+46 ;
+47 QUIT
+48 ;
VALIDMSG(MSGROOT,REQ,XMT,ERR) ;Validate message
+1 ;
+2 ; OMP^O09 messages must contain PID, ORC, and RXE segments
+3 ;
+4 ; The following sequences are required
+5 ; PID(3) - ICN/DFN
+6 ; ORC(2) - Placer Order Number
+7 ; RXE(1).4- Order Start Time
+8 ; RXE(15) - Prescription Number
+9 ;
+10 ; The following sequences are optional
+11 ;
+12 ; ERR = segment^sequence^field^code^ACK type^error text
+13 ;
+14 ; Input:
+15 ; MSGROOT - Root of array holding message
+16 ; XMT - Transmission parameters
+17 ;
+18 ; Output:
+19 ; REQ - Request Array
+20 ; XMT - Transmission parameters
+21 ; ERR - segment^sequence^field^code^ACK type^error text
+22 ;
+23 NEW MSH,PID,ORC,RXE,CNT,REQTYPE,I,ORDERCTL,PORDERN,ORDERQTY,GIVEID,GIVESYS,GIVEAMT,GIVEUNT,ORDERTM,RXNUM
+24 KILL REQ,ERR
+25 SET ERR=""
+26 ;
+27 ; Set up message ID for responding to message.
+28 ;---------------------------------------------
+29 ;Message ID
SET REQ("MID")=XMT("MID")
+30 ;
+31 ; Validate message is a well-formed OMP^O09 message
+32 ;-----------------------------------------------------------
+33 ; Must have MSH first followed by PID, then one or more ORC/RXE pairs
+34 ;
+35 IF $GET(@MSGROOT@(1,0))="MSH"
MERGE MSH=@MSGROOT@(1)
+36 IF '$TEST
SET ERR="MSH^1^^100^AE^Missing MSH segment"
QUIT 0
+37 ;
+38 IF $GET(@MSGROOT@(2,0))="PID"
MERGE PID=@MSGROOT@(2),REQ("PID")=PID
+39 IF '$TEST
SET ERR="PID^1^^100^AE^Missing PID segment"
QUIT 0
+40 ;
+41 SET CNT=3
+42 FOR
if '$DATA(@MSGROOT@(CNT))
QUIT
Begin DoDot:1
+43 IF $GET(@MSGROOT@(CNT,0))="ORC"
MERGE ORC(CNT\2)=@MSGROOT@(CNT)
+44 IF '$TEST
SET ERR="ORC^1^^100^AE^Missing ORC segment"
QUIT
+45 IF $GET(@MSGROOT@(CNT+1,0))="RXE"
MERGE RXE(CNT\2)=@MSGROOT@(CNT+1)
+46 IF '$TEST
SET ERR="RXE^1^^100^AE^Missing RXE segment"
QUIT
+47 SET CNT=CNT+2
+48 QUIT
End DoDot:1
if ERR'=""
QUIT
+49 if ERR'=""
QUIT 0
+50 ;
+51 IF '$DATA(ORC)
SET ERR="ORC^1^^100^AE^Missing ORC segment"
QUIT 0
+52 IF '$DATA(RXE)
SET ERR="RXE^1^^100^AE^Missing RXE segment"
QUIT 0
+53 ;
+54 ;
+55 ; Validate required fields and refill request parameters
+56 ;-----------------------------------------------------------
+57 ;
+58 IF '$$VALIDPID^MHV7RUS(.PID,.REQ,.ERR)
QUIT 0
+59 ;
+60 FOR I=1:1
if '$DATA(ORC(I))
QUIT
Begin DoDot:1
+61 SET ORDERCTL=$GET(ORC(I,1))
+62 SET PORDERN=$GET(ORC(I,2))
+63 IF ORDERCTL=""
SET ERR="ORC^"_I_"^2^101^AE^Missing Order Control"
QUIT
+64 IF PORDERN=""
SET ERR="ORC^"_I_"^2^101^AE^Missing Placer Order#"
QUIT
+65 ;
+66 SET ORDERQTY=$GET(RXE(I,1,1,1))
+67 SET ORDERTM=$GET(RXE(I,1,1,4))
+68 SET GIVEID=$GET(RXE(I,2,1,1))
+69 SET GIVESYS=$GET(RXE(I,2,1,3))
+70 SET GIVEAMT=$GET(RXE(I,3))
+71 SET GIVEUNT=$GET(RXE(I,5))
+72 SET RXNUM=$GET(RXE(I,15))
+73 IF ORDERQTY=""
SET ERR="RXE^"_I_"^1^101^AE^Missing Order Quantity"
QUIT
+74 IF ORDERTM=""
SET ERR="RXE^"_I_"^1^101^AE^Missing Order Start Time"
QUIT
+75 IF GIVEID=""
SET ERR="RXE^"_I_"^2^101^AE^Missign Give Code ID"
QUIT
+76 IF GIVESYS=""
SET ERR="RXE^"_I_"^2^101^AE^Missing Give Code System"
QUIT
+77 IF GIVEAMT=""
SET ERR="RXE^"_I_"^3^101^AE^Missing Give Amount"
QUIT
+78 IF GIVEUNT=""
SET ERR="RXE^"_I_"^5^101^AE^Missing Give Units"
QUIT
+79 IF RXNUM=""
SET ERR="RXE^"_I_"^15^101^AE^Missing Prescription#"
QUIT
+80 IF RXNUM'?1N.N0.1A
SET ERR="RXE^"_I_"^15^102^AE^Invalid Prescription#"
QUIT
+81 SET REQ("RX",I)=RXNUM_"^"_PORDERN_"^"_ORDERTM
+82 QUIT
End DoDot:1
if ERR'=""
QUIT
+83 if ERR'=""
QUIT 0
+84 ;
+85 IF '$$VALRTYPE^MHV7RU("RxRefill",.REQ,.ERR)
SET ERR="MSH^1^9^"_ERR
QUIT 0
+86 ;
+87 QUIT 1
+88 ;
