Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LA7VIN3

LA7VIN3.m

Go to the documentation of this file.
  1. LA7VIN3 ;DALOI/JMC - Process Incoming UI Msgs, continued ;11/17/11 15:55
  1. ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64,74,86**;Sep 27, 1994;Build 6
  1. ;
  1. ;This routine is a continuation of LA7VIN1 and is only called from there.
  1. Q
  1. ;
  1. MSA ; Process MSA segment
  1. ; The incoming MSA is used to update the status of the message
  1. ; in the LA7 MESSAGE QUEUE (#62.49)
  1. ;
  1. ; and
  1. ;
  1. ; if acknowledging ORU message - the ORDERS PENDING (#69.6) file
  1. ; if acknowledging ORM message - the SHIPPING MANIFEST (#62.8) file
  1. ;
  1. N LA7696,LA76964,LA7I,LA7MSAID,LA7MSTAT,LA7ORT,LA7RUID,LA7ST,LA7SITE,LA7X,LA7Y
  1. S LA7MSTAT=$$P^LA7VHLU(.LA7SEG,2,LA7FS)
  1. S LA7MSAID=$$P^LA7VHLU(.LA7SEG,3,LA7FS)
  1. I LA7MSAID="" Q
  1. ;
  1. ; Extract text message from MSA-3
  1. S LA7X=$$P^LA7VHLU(.LA7SEG,4,LA7FS)
  1. S LA7MSATM=$$UNESC^LA7VHLU3(LA7X,LA7FS_LA7ECH)
  1. ;
  1. ; Extract error condition from MSA-6
  1. S LA7X=$$P^LA7VHLU(.LA7SEG,7,LA7FS)
  1. I LA7X'="" D
  1. . S LA7Y=""
  1. . I $P(LA7X,$E(LA7ECH),2)'="" S LA7Y=$$UNESC^LA7VHLU3($P(LA7X,$E(LA7ECH),2),LA7FS_LA7ECH)
  1. . I $P(LA7X,$E(LA7ECH))'="" D
  1. . . I LA7Y="" S LA7Y=$$UNESC^LA7VHLU3($P(LA7X,$E(LA7ECH)),LA7FS_LA7ECH) Q
  1. . . S LA7Y="["_$P(LA7X,$E(LA7ECH))_"] "_LA7Y
  1. . S LA7MSATM=$S(LA7MSATM'="":LA7MSATM_" ",1:"")_LA7Y
  1. ;
  1. D SETID^LA7VHLU1(LA76249,LA7ID,"ACK-"_LA7MSAID,1)
  1. D SETID^LA7VHLU1(LA76249,"",LA7MSAID,0)
  1. ;
  1. S LA7ST=$$FIND1^DIC(64.061,"","MX","Results/data Received","","I $P(^(0),U,7)=""U""")
  1. ;
  1. ; Only look for messages id's that are outgoing messages, those that
  1. ; originated from this system. Other systems (incoming) messages can
  1. ; use a message id that is the same as a Vista message id.
  1. ;
  1. N LA76249
  1. S LA76249=0
  1. F S LA76249=$O(^LAHM(62.49,"ID",LA7MSAID,LA76249)) Q:'LA76249 D
  1. . I $P($G(^LAHM(62.49,LA76249,0)),"^",2)'="O" Q
  1. . D UPDF
  1. ;
  1. Q
  1. ;
  1. UPDF ; Update respective files
  1. ;
  1. N FDA,I,LA7ERR,LA7MTYPE,X
  1. ;
  1. F I=63,100 S LA76249(I)=$G(^LAHM(62.49,LA76249,I))
  1. ;
  1. ; Update original message in #62.49
  1. S FDA(1,62.49,LA76249_",",2)="X"
  1. I LA7MSTAT'="AA",LA7MSTAT'="CA" D
  1. . S FDA(1,62.49,LA76249_",",2)="E"
  1. . S FDA(1,62.49,LA76249_",",160)=LA7MSTAT
  1. . I LA7MSATM'="" S FDA(1,62.49,LA76249_",",161)=LA7MSATM
  1. D FILE^DIE("","FDA(1)","LA7ERR(1)")
  1. ;
  1. ; Send alert that original message had error.
  1. I LA7MSTAT'="AA",LA7MSTAT'="CA" D
  1. . D CREATE^LA7LOG(48)
  1. ;
  1. ; Retrieve original message's type.
  1. S LA7MTYPE=$P(LA76249(100),"^",9)
  1. ;
  1. ; If original message was an ORM, then update collecting facility's shipping manifest.
  1. I LA7MTYPE="ORM" D Q
  1. . ; Need to code this section - JMC 1/12/00
  1. . ; Need to figure out the shipping manifest which is being acknowledged
  1. . Q
  1. ;
  1. I LA7MTYPE'="ORU" Q
  1. ; Rest of this deals with updating order/test status in LAB PENDING ORDER file
  1. ; at host lab when collection facility is acknowledging receipt of ORU message.
  1. ;
  1. I LA76249(63)="" Q
  1. S LA7SITE=$P(LA76249(63),U,2),LA7RUID=$P(LA76249(63),U,3)
  1. I LA7SITE=""!(LA7RUID="") Q
  1. S LA7696=$O(^LRO(69.6,"RST",LA7SITE,LA7RUID,0))
  1. I LA7696="" Q
  1. ;
  1. ; Update order status in 69.6
  1. S FDA(2,69.6,LA7696_",",6)=LA7ST
  1. D FILE^DIE("","FDA(2)","LA7ERR(2)")
  1. ;
  1. S LA7ORT=$P(LA76249(63),U,4),LA76964=0
  1. I LA7ORT'="" S LA76964=$O(^LRO(69.6,LA7696,2,"B",LA7ORT,0))
  1. I 'LA76964 D
  1. . S LA7ORT=$P(LA76249(63),U,5)
  1. . I LA7ORT'="" S LA76964=$O(^LRO(69.6,LA7696,2,"C",LA7ORT,0))
  1. I LA76964<1 Q
  1. ;
  1. ; Update test status in 69.6
  1. S FDA(3,69.64,LA76964_","_LA7696_",",5)=LA7ST
  1. D FILE^DIE("","FDA(3)","LA7ERR(3)")
  1. ;
  1. Q