LA7VLIN3 ;VA/DALOI/JMC - Process Incoming UI Msgs, continued ;JUL 06, 2010 3:14 PM
;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64,1027**;NOV 01, 1997
;This routine is a continuation of LA7VIN1 and is only called from there.
Q
;
MSA ; Process MSA segment
; The incoming MSA is used to update the status of the message
; in the LA7 MESSAGE QUEUE (#62.49)
;
; and
;
; if acknowledging ORU message - the ORDERS PENDING (#69.6) file
; if acknowledging ORM message - the SHIPPING MANIFEST (#62.8) file
;
N LA7696,LA76964,LA7I,LA7MSAID,LA7MSTAT,LA7ORT,LA7RUID,LA7ST,LA7SITE,LA7X,LA7Y
S LA7MSTAT=$$P^LA7VHLU(.LA7SEG,2,LA7FS)
S LA7MSAID=$$P^LA7VHLU(.LA7SEG,3,LA7FS)
;
; Extract text message from MSA-3
S LA7X=$$P^LA7VHLU(.LA7SEG,4,LA7FS)
S LA7MSATM=$$UNESC^LA7VHLU3(LA7X,LA7FS_LA7ECH)
;
; Extract error condition from MSA-6
S LA7X=$$P^LA7VHLU(.LA7SEG,7,LA7FS)
I LA7X'="" D
. S LA7Y=""
. I $P(LA7X,$E(LA7ECH),2)'="" S LA7Y=$$UNESC^LA7VHLU3($P(LA7X,$E(LA7ECH),2),LA7FS_LA7ECH)
. I $P(LA7X,$E(LA7ECH))'="" D
. . I LA7Y="" S LA7Y=$$UNESC^LA7VHLU3($P(LA7X,$E(LA7ECH)),LA7FS_LA7ECH) Q
. . S LA7Y="["_$P(LA7X,$E(LA7ECH))_"] "_LA7Y
. S LA7MSATM=$S(LA7MSATM'="":LA7MSATM_" ",1:"")_LA7Y
I LA7MSAID="" Q
;
D SETID^LA7VHLU1(LA76249,LA7ID,"ACK-"_LA7MSAID)
;
S LA7ST=$$FIND1^DIC(64.061,"","MX","Results/data Received","","I $P(^(0),U,7)=""U""")
;
; Only look for messages id's that are outgoing messages, those that
; originated from this system. Other systems (incoming) messages can
; use a message id that is the same as a Vista message.
;
N LA76249
S LA76249=0
F S LA76249=$O(^LAHM(62.49,"ID",LA7MSAID,LA76249)) Q:'LA76249 D
. I $P($G(^LAHM(62.49,LA76249,0)),"^",2)'="O" Q
. D UPDF
;
Q
;
UPDF ; Update respective files
;
N FDA,I,LA7ERR,LA7MTYPE,X
;
F I=63,100 S LA76249(I)=$G(^LAHM(62.49,LA76249,I))
;
; Update original message in #62.49
S FDA(1,62.49,LA76249_",",2)="X"
I LA7MSTAT'="AA",LA7MSTAT'="CA" D
. S FDA(1,62.49,LA76249_",",2)="E"
. S FDA(1,62.49,LA76249_",",160)=LA7MSTAT
. I LA7MSATM'="" S FDA(1,62.49,LA76249_",",161)=LA7MSATM
D FILE^DIE("","FDA(1)","LA7ERR(1)")
;
; Send alert that original message had error.
I LA7MSTAT'="AA",LA7MSTAT'="CA" D
. D CREATE^LA7LOG(48)
;
; Retrieve original message's type.
S LA7MTYPE=$P(LA76249(100),"^",9)
;
; If original message was an ORM, then update collecting facility's shipping manifest.
I LA7MTYPE="ORM" D Q
. ; Need to code this section - JMC 1/12/00
. ; Need to figure out the shipping manifest which is being acknowledged
. Q
;
I LA7MTYPE'="ORU" Q
; Rest of this deals with updating order/test status in LAB PENDING ORDER file
; at host lab when collection facility is acknowledging receipt of ORU message.
;
I LA76249(63)="" Q
S LA7SITE=$P(LA76249(63),U,2),LA7RUID=$P(LA76249(63),U,3)
S LA7696=$O(^LRO(69.6,"RST",LA7SITE,LA7RUID,0))
I LA7696="" Q
;
; Update order status in 69.6
S FDA(2,69.6,LA7696_",",6)=LA7ST
D FILE^DIE("","FDA(2)","LA7ERR(2)")
;
S LA7ORT=$P(LA76249(63),U,4),LA76964=0
I LA7ORT'="" S LA76964=$O(^LRO(69.6,LA7696,2,"B",LA7ORT,0))
I 'LA76964 D
. S LA7ORT=$P(LA76249(63),U,5)
. I LA7ORT'="" S LA76964=$O(^LRO(69.6,LA7696,2,"C",LA7ORT,0))
I LA76964<1 Q
;
; Update test status in 69.6
S FDA(3,69.64,LA76964_","_LA7696_",",5)=LA7ST
D FILE^DIE("","FDA(3)","LA7ERR(3)")
;
Q
LA7VLIN3 ;VA/DALOI/JMC - Process Incoming UI Msgs, continued ;JUL 06, 2010 3:14 PM
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64,1027**;NOV 01, 1997
+2 ;This routine is a continuation of LA7VIN1 and is only called from there.
+3 QUIT
+4 ;
MSA ; Process MSA segment
+1 ; The incoming MSA is used to update the status of the message
+2 ; in the LA7 MESSAGE QUEUE (#62.49)
+3 ;
+4 ; and
+5 ;
+6 ; if acknowledging ORU message - the ORDERS PENDING (#69.6) file
+7 ; if acknowledging ORM message - the SHIPPING MANIFEST (#62.8) file
+8 ;
+9 NEW LA7696,LA76964,LA7I,LA7MSAID,LA7MSTAT,LA7ORT,LA7RUID,LA7ST,LA7SITE,LA7X,LA7Y
+10 SET LA7MSTAT=$$P^LA7VHLU(.LA7SEG,2,LA7FS)
+11 SET LA7MSAID=$$P^LA7VHLU(.LA7SEG,3,LA7FS)
+12 ;
+13 ; Extract text message from MSA-3
+14 SET LA7X=$$P^LA7VHLU(.LA7SEG,4,LA7FS)
+15 SET LA7MSATM=$$UNESC^LA7VHLU3(LA7X,LA7FS_LA7ECH)
+16 ;
+17 ; Extract error condition from MSA-6
+18 SET LA7X=$$P^LA7VHLU(.LA7SEG,7,LA7FS)
+19 IF LA7X'=""
Begin DoDot:1
+20 SET LA7Y=""
+21 IF $PIECE(LA7X,$EXTRACT(LA7ECH),2)'=""
SET LA7Y=$$UNESC^LA7VHLU3($PIECE(LA7X,$EXTRACT(LA7ECH),2),LA7FS_LA7ECH)
+22 IF $PIECE(LA7X,$EXTRACT(LA7ECH))'=""
Begin DoDot:2
+23 IF LA7Y=""
SET LA7Y=$$UNESC^LA7VHLU3($PIECE(LA7X,$EXTRACT(LA7ECH)),LA7FS_LA7ECH)
QUIT
+24 SET LA7Y="["_$PIECE(LA7X,$EXTRACT(LA7ECH))_"] "_LA7Y
End DoDot:2
+25 SET LA7MSATM=$SELECT(LA7MSATM'="":LA7MSATM_" ",1:"")_LA7Y
End DoDot:1
+26 IF LA7MSAID=""
QUIT
+27 ;
+28 DO SETID^LA7VHLU1(LA76249,LA7ID,"ACK-"_LA7MSAID)
+29 ;
+30 SET LA7ST=$$FIND1^DIC(64.061,"","MX","Results/data Received","","I $P(^(0),U,7)=""U""")
+31 ;
+32 ; Only look for messages id's that are outgoing messages, those that
+33 ; originated from this system. Other systems (incoming) messages can
+34 ; use a message id that is the same as a Vista message.
+35 ;
+36 NEW LA76249
+37 SET LA76249=0
+38 FOR
SET LA76249=$ORDER(^LAHM(62.49,"ID",LA7MSAID,LA76249))
IF 'LA76249
QUIT
Begin DoDot:1
+39 IF $PIECE($GET(^LAHM(62.49,LA76249,0)),"^",2)'="O"
QUIT
+40 DO UPDF
End DoDot:1
+41 ;
+42 QUIT
+43 ;
UPDF ; Update respective files
+1 ;
+2 NEW FDA,I,LA7ERR,LA7MTYPE,X
+3 ;
+4 FOR I=63,100
SET LA76249(I)=$GET(^LAHM(62.49,LA76249,I))
+5 ;
+6 ; Update original message in #62.49
+7 SET FDA(1,62.49,LA76249_",",2)="X"
+8 IF LA7MSTAT'="AA"
IF LA7MSTAT'="CA"
Begin DoDot:1
+9 SET FDA(1,62.49,LA76249_",",2)="E"
+10 SET FDA(1,62.49,LA76249_",",160)=LA7MSTAT
+11 IF LA7MSATM'=""
SET FDA(1,62.49,LA76249_",",161)=LA7MSATM
End DoDot:1
+12 DO FILE^DIE("","FDA(1)","LA7ERR(1)")
+13 ;
+14 ; Send alert that original message had error.
+15 IF LA7MSTAT'="AA"
IF LA7MSTAT'="CA"
Begin DoDot:1
+16 DO CREATE^LA7LOG(48)
End DoDot:1
+17 ;
+18 ; Retrieve original message's type.
+19 SET LA7MTYPE=$PIECE(LA76249(100),"^",9)
+20 ;
+21 ; If original message was an ORM, then update collecting facility's shipping manifest.
+22 IF LA7MTYPE="ORM"
Begin DoDot:1
+23 ; Need to code this section - JMC 1/12/00
+24 ; Need to figure out the shipping manifest which is being acknowledged
+25 QUIT
End DoDot:1
QUIT
+26 ;
+27 IF LA7MTYPE'="ORU"
QUIT
+28 ; Rest of this deals with updating order/test status in LAB PENDING ORDER file
+29 ; at host lab when collection facility is acknowledging receipt of ORU message.
+30 ;
+31 IF LA76249(63)=""
QUIT
+32 SET LA7SITE=$PIECE(LA76249(63),U,2)
SET LA7RUID=$PIECE(LA76249(63),U,3)
+33 SET LA7696=$ORDER(^LRO(69.6,"RST",LA7SITE,LA7RUID,0))
+34 IF LA7696=""
QUIT
+35 ;
+36 ; Update order status in 69.6
+37 SET FDA(2,69.6,LA7696_",",6)=LA7ST
+38 DO FILE^DIE("","FDA(2)","LA7ERR(2)")
+39 ;
+40 SET LA7ORT=$PIECE(LA76249(63),U,4)
SET LA76964=0
+41 IF LA7ORT'=""
SET LA76964=$ORDER(^LRO(69.6,LA7696,2,"B",LA7ORT,0))
+42 IF 'LA76964
Begin DoDot:1
+43 SET LA7ORT=$PIECE(LA76249(63),U,5)
+44 IF LA7ORT'=""
SET LA76964=$ORDER(^LRO(69.6,LA7696,2,"C",LA7ORT,0))
End DoDot:1
+45 IF LA76964<1
QUIT
+46 ;
+47 ; Update test status in 69.6
+48 SET FDA(3,69.64,LA76964_","_LA7696_",",5)=LA7ST
+49 DO FILE^DIE("","FDA(3)","LA7ERR(3)")
+50 ;
+51 QUIT
