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

LA7UIIN1.m

Go to the documentation of this file. 
  1. LA7UIIN1 ;DALOI/JRR - Process Incoming UI Msgs, continued ; 12/3/1997
  1.  ;;5.2;AUTOMATED LAB INSTRUMENTS;**17,23,27,57,59**;Sep 27, 1994
  1.  ; This routine is a continuation of LA7UIIN and is only
  1.  ; called from there.  It is called with each message found
  1.  ; in the incoming queue.  
  1.  ;
  1.  Q
  1.  ;
  1. NXTMSG ;
  1.  N LA70070,LA7150,LA761,LA762,LA7624,LA762495
  1.  N LA7AA,LA7AD,LA7ACC,LA7CNT,LA7CS,LA7CUP,LA7ECH,LA7ENTRY,LA7FS,LA7IDE,LA7LWL,LA7MSH,LA7OBR,LA7OBR3,LA7QUIT,LA7TRAY,LA7USID
  1.  N CUP,IDE,IDENT,ISQN
  1.  ;
  1.  S (LA7CNT,LA7QUIT)=0
  1.  S (LA7AN,LA7INST,LA7OBR,LA7UID)=""
  1.  S DT=$$DT^XLFDT
  1.  ; Message built but no text.
  1.  I '$O(^LAHM(62.49,LA76249,150,0)) D  Q
  1.  . D CREATE^LA7LOG(6)
  1.  ;
  1. MSH S LA7MSH=$G(^($O(^LAHM(62.49,LA76249,150,0)),0))
  1.  ; Bad first line of message
  1.  I $E(LA7MSH,1,3)'="MSH" D  Q
  1.  . D CREATE^LA7LOG(7)
  1.  S LA7FS=$E(LA7MSH,4)
  1.  S LA7CS=$E(LA7MSH,5)
  1.  S LA7ECH=$E(LA7MSH,5,8)
  1.  ; No field or component seperator
  1.  I LA7FS=""!(LA7CS="") D  Q
  1.  . D CREATE^LA7LOG(8)
  1.  ;
  1.  ; Find the OBR segment
  1.  S LA762495=0
  1. OBR F  S LA762495=$O(^LAHM(62.49,LA76249,150,LA762495)) Q:'LA762495!($E($G(^(+LA762495,0)),1,3)="OBR")
  1.  S DT=$$DT^XLFDT
  1.  ;
  1.  ; No more OBR's, found at least 1.
  1.  I 'LA762495,$L($G(LA7OBR)) Q
  1.  ;
  1.  S LA7OBR=$G(^LAHM(62.49,LA76249,150,+LA762495,0))
  1.  ;
  1.  ; Should only be working on OBR
  1.  I $E(LA7OBR,1,3)'="OBR" D  Q
  1.  . D CREATE^LA7LOG(9)
  1.  ;
  1.  ; Extracting 1st piece
  1.  S LA7INST=$P($P(LA7OBR,LA7FS,19),LA7CS,1)
  1.  I LA7INST="" D  Q
  1.  . D CREATE^LA7LOG(10)
  1.  S LA7624=+$O(^LAB(62.4,"B",LA7INST,0))
  1.  ; Instrument name not found in xref
  1.  I 'LA7624 D  Q
  1.  . D CREATE^LA7LOG(11)
  1.  S LA7INST=$G(^LAB(62.4,LA7624,0))
  1.  ; Instrument entry not found in file
  1.  I LA7INST="" D  Q
  1.  . D CREATE^LA7LOG(11)
  1.  ;
  1.  S LA7ENTRY=$P(LA7INST,"^",6) ;LOG,LLIST,IDENT or SEQN
  1.  S:LA7ENTRY="" LA7ENTRY="LOG"
  1.  ;
  1.  ; Universal service id
  1.  S LA7USID=$P(LA7OBR,LA7FS,4)
  1.  ;
  1.  S LA7TRAY=+$P($P(LA7OBR,LA7FS,20),LA7CS,1) ;Tray
  1.  S LA7CUP=+$P($P(LA7OBR,LA7FS,20),LA7CS,2) ; Cup
  1.  S LA7AA=+$P($P(LA7OBR,LA7FS,20),LA7CS,3) ;  Accession Area
  1.  S LA7AD=+$P($P(LA7OBR,LA7FS,20),LA7CS,4) ;  Accession Date
  1.  S LA7AN=+$P($P(LA7OBR,LA7FS,20),LA7CS,5) ;  Accession Entry
  1.  S LA7ACC=$P($P(LA7OBR,LA7FS,20),LA7CS,6) ;  Accession
  1.  S LA7UID=$P($P(LA7OBR,LA7FS,20),LA7CS,7) ;  Unique ID
  1.  S LA7IDE=$P($P(LA7OBR,LA7FS,20),LA7CS,8) ;  Sequence Number
  1.  S LA7LWL=$P(LA7INST,"^",4) ;  Load/Work List
  1.  S LA7OBR3=$P(LA7OBR,LA7FS,3) ; Sample ID or Bar code
  1.  S LA7OBR(15)=$P(LA7OBR,LA7FS,16) ; Specimen source
  1.  ;
  1.  ; UID might come as Sample ID
  1.  I LA7UID="",LA7OBR3?10UN S LA7UID=LA7OBR3
  1.  ;
  1.  ; Try to figure out LRAA LRAD LRAN by using the unique ID (LRUID)
  1.  ; accession may have rolled over, use UID to get current accession info.
  1.  I LA7UID]"" D
  1.  . N X
  1.  . S X=$Q(^LRO(68,"C",LA7UID))
  1.  . I $QS(X,3)'=LA7UID S LA7UID="" Q  ; UID not on file.
  1.  . S LA7AA=+$QS(X,4),LA7AD=+$QS(X,5),LA7AN=+$QS(X,6)
  1.  ; If still not known, compute from default date and accession area
  1.  ; Calculate accession date based on accession transform.
  1.  I '(LA7AA*LA7AD*LA7AN) D
  1.  . N X
  1.  . S DT=$$DT^XLFDT
  1.  . S LA7AA=+$P(LA7INST,"^",11)
  1.  . S X=$P($G(^LRO(68,LA7AA,0)),U,3)
  1.  . S LA7AD=$S(X="D":DT,X="M":$E(DT,1,5)_"00",X="Y":$E(DT,1,3)_"0000",X="Q":$E(DT,1,3)_"0000"+(($E(DT,4,5)-1)\3*300+100),1:DT)
  1.  . S LA7AN=+LA7OBR3
  1.  ; Log but cont
  1.  I LA7ENTRY="LOG",'$D(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,0)) D
  1.  . D CREATE^LA7LOG(13)
  1.  ; cup=sequence number
  1.  I LA7ENTRY="LLIST" S:'LA7CUP LA7CUP=LA7IDE
  1.  ;
  1.  ; Create entry in ^LAH global
  1.  D LAGEN
  1.  ; Couldn't create entry in ^LAH
  1.  I $G(LA7ISQN)="" D  Q
  1.  . D CREATE^LA7LOG(14)
  1.  ;
  1.  ; specimen(topography), collection sample, HL7 specimen source
  1.  S (LA761,LA762,LA70070)=""
  1.  I $O(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,5,0)) D
  1.  . N X
  1.  . S X=$O(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,5,0))
  1.  . ; specimen^collection sample
  1.  . S X(0)=$G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,5,X,0))
  1.  . S LA761=$P(X(0),"^") ; specimen
  1.  . S LA762=$P(X(0),"^",2) ; collection sample
  1.  . ; HL7 code from Topography
  1.  . I LA761 S LA70070=$$GET1^DIQ(61,LA761_",","LEDI HL7:HL7 ABBR")
  1.  ;
  1.  ; Log error when specimen source does not match accession's specimen
  1.  I $L(LA70070),$L($P($P(LA7OBR(15),LA7CS),$E(LA7ECH,4))) D
  1.  . ; Check if using HL7 table 0070
  1.  . I $P($P(LA7OBR(15),LA7CS),$E(LA7ECH,4),3)'["0070" Q
  1.  . ; Message matches accession
  1.  . I LA70070=$P($P(LA7OBR(15),LA7CS),$E(LA7ECH,4)) Q
  1.  . D CREATE^LA7LOG(22)
  1.  . S LA7QUIT=1
  1.  ;
  1.  ; Something wrong, process next OBR
  1.  I LA7QUIT S LA7QUIT=0 G OBR
  1.  ;
  1.  ; Zeroth node of acession area.
  1.  S LA7AA(0)=$G(^LRO(68,+LA7AA,0))
  1.  ;
  1.  ; No subscript defined for this area.
  1.  I $P(LA7AA(0),"^",2)="" G OBR
  1.  ;
  1.  ; Processing of this subscript not supported.
  1.  I "CHMI"'[$P(LA7AA(0),"^",2) G OBR
  1.  ;
  1.  S LA7150=LA762495
  1.  ; Process "CH" subscript results - NTE and OBX segments.
  1.  I $P(LA7AA(0),"^",2)="CH" D NTE^LA7UIIN2
  1.  ;
  1.  ; Process "MI" subscript results.
  1.  I $P(LA7AA(0),"^",2)="MI" D
  1.  . N X
  1.  . S X="LA7UIIN3" X ^%ZOSF("TEST") Q:'$T
  1.  . D MI^LA7UIIN3
  1.  ;
  1.  ; No more segments to process, reached end of global array.
  1.  I 'LA762495 Q
  1.  ;
  1.  ; Reset subscript variable.
  1.  I LA762495>LA7150 S LA762495=LA762495-1
  1.  ;
  1.  ; Go back to find/process additional OBR segments.
  1.  G OBR
  1.  ;
  1.  ;
  1. LAGEN ; subroutine to set up variables for call to ^LAGEN, build entry in LAH
  1.  ; requires LA7INST,LA7TRAY,LA7CUP,LA7AA,LA7AD,LA7AN,LA7LWL
  1.  ; returns LA7ISQN=subscript to store results in ^LAH global
  1.  ;
  1.  K TRAY,CUP,LWL,WL,LROVER,METH,LOG,IDENT,ISQN
  1.  K LADT,LAGEN,LA7ISQN
  1.  ;
  1.  S LA7ISQN=""
  1.  S TRAY=+$G(LA7TRAY) S:'TRAY TRAY=1
  1.  S CUP=+$G(LA7CUP) S:'CUP CUP=1
  1.  S LWL=LA7LWL
  1.  I '$D(^LRO(68.2,+LWL,0)) D  Q
  1.  . D CREATE^LA7LOG(19)
  1.  ;
  1.  ; Set accession area to area of specimen, allow multiple areas on same instrument.
  1.  S WL=LA7AA
  1.  I '$D(^LRO(68,+WL,0)) D  Q
  1.  . D CREATE^LA7LOG(20)
  1.  ;
  1.  S LROVER=$P(LA7INST,"^",12)
  1.  S METH=$P(LA7INST,"^",10)
  1.  S LOG=LA7AN
  1.  ; Identity field
  1.  S IDENT=$P($G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,0)),"^",6)
  1.  S IDE=+LA7IDE
  1.  S LADT=LA7AD
  1.  ;
  1.  ; This disregards the CROSS LINK field in 62.4
  1.  D @(LA7ENTRY_"^LAGEN")
  1.  S LA7ISQN=$G(ISQN)
  1.  ;
  1.  Q