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

LA7VIN4A.m

Go to the documentation of this file. 
  1. LA7VIN4A ;DALOI/JMC - Process Incoming UI Msgs, continued ;Jun 14, 2022@18:38
  1.  ;;5.2;AUTOMATED LAB INSTRUMENTS;**74,80,88,101**;Sep 27, 1994;Build 6
  1.  ;
  1.  ;This routine is a continuation of LA7VIN4 and is only called from there.
  1.  Q
  1.  ;
  1.  ; ZEXCEPT is used to identify variables which are external to a specific TAG
  1.  ;         used in conjunction with Eclipse M-editor.
  1.  ;
  1. LAGEN ; Sets 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.  I LA7ENTRY="LOG" D
  1.  . I LA7INTYP>19,LA7INTYP<30 Q
  1.  . I '$D(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,0)) S LA7ERR=13,LA7AERR=$$CREATE^LA7LOG(LA7ERR,1)
  1.  I LA7ENTRY="LLIST" S:'LA7CUP LA7CUP=LA7IDE ;cup=sequence number
  1.  ;
  1.  K LA7ISQN,LADT,LAGEN
  1.  K TRAY,CUP,LWL,WL,LROVER,METH,LOG,IDENT,ISQN
  1.  ;
  1.  S LA7ISQN=""
  1.  S TRAY=+$G(LA7TRAY) S:'TRAY TRAY=1
  1.  S CUP=+$G(LA7CUP) S:'CUP CUP=1
  1.  ;
  1.  S LWL=LA7LWL
  1.  I '$D(^LRO(68.2,+LWL,0)) D  Q
  1.  . S LA7ERR=19,LA7AERR=$$CREATE^LA7LOG(LA7ERR,1)
  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.  . S LA7ERR=20,LA7AERR=$$CREATE^LA7LOG(LA7ERR,1)
  1.  S LROVER=$P(LA7624(0),"^",12)
  1.  ;
  1.  ; LEDI(MI & AP) override #62.4 setting so results never overlay unless same message
  1.  I LA7INTYP=10 D
  1.  . I LA7SS'?1(1"MI",1"SP",1"CY",1"EM") Q
  1.  . ; Use same entry in LAH if handling multiple OBR within same message for same accession/test
  1.  . I $P($G(LA7INTYP("ISQN",LWL)),"^",1,3)=(LA76249_"^"_LA7UID_"^"_LA7ONLT) S ISQN=$P(LA7INTYP("ISQN",LWL),"^",4),LROVER=2 Q
  1.  . S LROVER=0
  1.  S METH=$P(LA7624(0),"^",10)
  1.  S LOG=LA7AN
  1.  S IDENT=$P($G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,0)),"^",6) ;identity field
  1.  S IDE=+LA7IDE
  1.  S LADT=LA7AD
  1.  ;
  1.  ; If auto release then set flag to not overlay data in LAH unless from same message.
  1.  I LA7OBR49="AR" S LROVER=0
  1.  I $G(LA7UID)'="",$D(^TMP("LA7 AR",$J,LA7LWL,1,"AUTOREL-UID",LA7UID)) D
  1.  . N I
  1.  . S I=0
  1.  . F  S I=$O(^TMP("LA7 AR",$J,LA7LWL,1,"AUTOREL-UID",LA7UID,I)) Q:'I  I $D(^TMP("LA7 AR",$J,LA7LWL,1,"AUTOREL-UID",LA7UID,I,LA76249)) S ISQN=I,LROVER=2 Q
  1.  ;
  1.  I LROVER<2 D
  1.  . N LRDFN ; Protect LRDFN - call into LAGEN can set to 0
  1.  . ;
  1.  . ; If POC interface call special entry point
  1.  . I LA7INTYP>19,LA7INTYP<30 S IDE=LA76249 D POC^LAGEN Q
  1.  . ;
  1.  . D @(LA7ENTRY_"^LAGEN") ;this disregards the CROSS LINK field in 62.4
  1.  ;
  1.  S LA7ISQN=$G(ISQN)
  1.  ;
  1.  I LA7ISQN<1 Q
  1.  ; Save entry made in LAH for this load list and message for this accession (UID)
  1.  I LA7INTYP=10 S LA7INTYP("ISQN",LWL)=LA76249_"^"_LA7UID_"^"_LA7ONLT_"^"_LA7ISQN
  1.  ;
  1.  ; Build/store patient demographics array
  1.  N I,J,LA7OBRA,LA7PIDA,X,Y
  1.  S J="DFN^DOB^ICN^LOC^LRDFN^LRTDFN^PNM^SEX^SSN"
  1.  S J(0)="DFN^LA7DOB^LA7ICN^LA7LOC^LRDFN^LRTDFN^LA7PNM^LA7SEX^LA7SSN"
  1.  F I=1:1 S X=$P(J,"^",I) Q:X=""  D
  1.  . S Y=$P(J(0),"^",I)
  1.  . I $G(@Y)'="" S LA7PIDA(X)=@Y
  1.  I $D(LA7PIDA) D POI^LAGEN(LA7LWL,LA7ISQN,"PID",.LA7PIDA)
  1.  ;
  1.  ; Build/store order info array
  1.  N LA7ONLTS
  1.  I LA7POP'="" S LA7POP=$P(LA7POP," [")
  1.  S X=$G(^LAH(LA7LWL,1,LA7ISQN,.1,"OBR","ORDNLT"))
  1.  I X'="",LA7ONLT'="",X'[LA7ONLT S LA7ONLTS=X_"^"_LA7ONLT
  1.  E  S LA7ONLTS=LA7ONLT
  1.  S J="EOL^FID^ORCDT^ORDNLT^ORDP^ORDSPEC^PON^SID^PEB^PVB^PRI^ARI^TECH"
  1.  S J(0)="LA7EOL^LA7FID^LA7CDT^LA7ONLTS^LA7POP^LA7SPEC^LA7PON^LA7SID^LA7PEB^LA7PVB^LA7PRI^LA7ARI^LA7TECH"
  1.  F I=1:1 S X=$P(J,"^",I) Q:X=""  D
  1.  . S Y=$P(J(0),"^",I)
  1.  . I $G(@Y)'="" S LA7OBRA(X)=@Y
  1.  I $D(LA7OBRA) D POI^LAGEN(LA7LWL,LA7ISQN,"OBR",.LA7OBRA)
  1.  ;
  1.  ; Save placer fields 1/2 and filler fields 1/2
  1.  I LA7SOBR>0 F I=18:1:21 S X=$P("PF1^PF2^FF1^FF2","^",I-17) S ^LAH(LA7LWL,1,LA7ISQN,.1,"OBR",X,LA7SOBR)=LA7OBR(I)
  1.  ;
  1.  ; Store interface type with results
  1.  D LATYP^LAGEN(LA7LWL,LA7ISQN,LA7INTYP)
  1.  ;
  1.  ; Store #62.49 ien with results
  1.  D LAMSGID^LAGEN(LA7LWL,LA7ISQN,LA76249)
  1.  ;
  1.  ; Store method name with LAH entry
  1.  D METH^LAGEN(LA7LWL,LA7ISQN,METH)
  1.  ;
  1.  ; Set flag if POC interface to start POC processing routine when
  1.  ; finished - tasked by LA7VIN before shutdown
  1.  I LA7INTYP>19,LA7INTYP<30 S LA7INTYP("LWL",LA7LWL)=""
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. SMUPDT ; Update shipping manifest in shipping event file #62.85
  1.  N LA7DATA,LA7NCS,LA7TST,LA7USID
  1.  ;
  1.  S LA7USID=$$P^LA7VHLU(.LA7SEG,5,LA7FS) ; Universal Service ID (OBR-4)
  1.  S LA7TST=$P(LA7USID,LA7CS,1) ; Test code
  1.  S LA7NCS=$P(LA7USID,LA7CS,3) ; Name of coding system
  1.  S LA7TST(2)=$P(LA7USID,LA7CS,4) ; Alternate test code
  1.  S LA7NCS(2)=$P(LA7USID,LA7CS,6) ; Alternate coding system
  1.  ;
  1.  ; Determine ordered test, check primary and alternate
  1.  ;LA*5.2*101: Pass in LA7629
  1.  S LA7OTST=$$DOT^LA7SMU1(LA7TST,LA7NCS,LA7UID,$P(LA7SM,"^"),$G(LA7629))
  1.  I 'LA7OTST,LA7TST(2)'="" S LA7OTST=$$DOT^LA7SMU1(LA7TST(2),LA7NCS(2),LA7UID,$P(LA7SM,"^"),$G(LA7629))
  1.  ;
  1.  ; Flag the Results Received Event in #62.85
  1.  I LA7MTYP="ORU" D
  1.  . S LA7DATA="SM70"_"^"_LA7MEDT_"^"_$G(LA7OTST)_"^"_$P(LA7SM,"^",2)
  1.  . D SEUP^LA7SMU(LA7UID,"2",LA7DATA)
  1.  ;
  1.  ; Flag the Test Received Event in #62.85
  1.  I LA7MTYP="ORR" D
  1.  . S LA7DATA="SM55"_"^"_LA7MEDT_"^"_$G(LA7OTST)_"^"_$P(LA7SM,"^",2)
  1.  . D SEUP^LA7SMU(LA7UID,"2",LA7DATA)
  1.  Q