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

LA7VORR1.m

Go to the documentation of this file. 
  1. LA7VORR1 ;BIRMFO/DLR - LAB ORM (Order Response) message builder ; 12-12-96
  1.  ;;5.2;LAB MESSAGING;**27**;Sep 27, 1994
  1. EN(LA) ;
  1.  S GBL="^TMP(""HLS"","_$J_")",ORDER="^LRO(69.6)"
  1.  ;assuming the receiving institution is the primary site (site with the computer system)
  1.  ; LA("AUTO-INST") - Auto-Instrument
  1.  N PRIMARY S PRIMARY=$$PRIM^VASITE(DT) I $G(PRIMARY)'="" S PRIMARY=$$SITE^VASITE(DT,PRIMARY) S PRIMARY=$P(PRIMARY,U,3)
  1.  S LA("AUTO-INST")="LA7V HOST "_PRIMARY
  1.  D MSA,PID,ACC
  1. EXIT Q
  1. MSA ;
  1.  N ID
  1.  S ID=$O(^LRO(69.6,"RST",LA("SITE"),LA("RUID"),0)) I $G(ID)'="" S ID=$P(^LRO(69.6,ID,1),U,8)
  1.  S @GBL@(LA("I"))="MSA"_HL("FS")_"AA"_HL("FS")_$G(ID)
  1.  S LA("I")=LA("I")+1
  1.  Q
  1. PID ;Original routine saved as all lower case  Frank
  1.  ;S HLFS="^",HLECH="~|&\",HLQ="""""",HLCOMP="~"
  1.  N NODE0,LRHMSG
  1.  Q:$G(LA("LRDFN"))=""
  1.  ;Q:LA("LRDFN")=$G(LA("LLRDFN"))
  1.  I $P(^LR(LA("LRDFN"),0),U,2)=2 S DFN=$P(^LR(LA("LRDFN"),0),U,3) S (LRHMSG,@GBL@(LA("I")))=$$EN^VAFHLPID(DFN,"1,3,5,7,8,19",1),$P(@GBL@(LA("I")),HLFS,4)=$$M11^HLFNC(LA("LRDFN"))
  1.  I $P(^LR(LA("LRDFN"),0),U,2)=67 D
  1.  . S NODE0=^LR(LA("LRDFN"),0),DFN=$P(NODE0,U,3)
  1.  . S LRHMSG="PID"_HLFS_LA("PCNT")_HLFS_HLFS_$$M11^HLFNC(LA("LRDFN"))_HLFS_HLFS_$$HLNAME^HLFNC($P(^LRT(67,DFN,0),U),HLECH)
  1.  . S LRHMSG=LRHMSG_HLFS_HLFS_$$HLDATE^HLFNC($P(NODE0,U,3),"DT")_HLFS_$P(NODE0,U,2)
  1.  . S @GBL@(LA("I"))=LRHMSG
  1.  S LA("I")=LA("I")+1,LA("PCNT")=$G(LA("PCNT"))+1
  1.  S LA("LLRDFN")=LA("LRDFN")
  1.  Q
  1. ACC ;
  1.  N LRAA,LRAD,LRAN
  1.  S LRAA=0 F  S LRAA=$O(^LRO(68,"C",LA("RUID"),LRAA)) Q:'LRAA  S LRAD=0 F  S LRAD=$O(^LRO(68,"C",LA("RUID"),LRAA,LRAD)) Q:'LRAD  S LRAN=0 F  S LRAN=$O(^LRO(68,"C",LA("RUID"),LRAA,LRAD,LRAN)) Q:'LRAN  D OBR
  1.  Q
  1. PV1 ;
  1.  S @GBL@(LA("I"))="PV1"_HLFS_1_HLFS_HLFS_$P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,7),LA("I")=LA("I")+1
  1.  Q
  1. ORC ;Order Control
  1.  N ORC
  1.  S @GBL@(LA("I"))="ORC"
  1.  S ORC(1)="OK"
  1.  S ORC(2)=LA("RUID")
  1.  S ORC(3)=LA("HUID")
  1.  S ORC(9)=$$HLDATE^HLFNC($P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,4))  ; Order Date/Time
  1.  S ORC(12)=$$HLNAME^HLFNC($$GET1^DIQ(68.02,LRAN_","_LRAD_","_LRAA_",",6.5))
  1.  F X=1:1:27 S @GBL@(LA("I"))=$G(@GBL@(LA("I")))_HLFS_$G(ORC(X))
  1.  S LA("I")=$G(LA("I"))+1
  1.  Q
  1. OBR ;Observation Request segment for Lab Order
  1.  N OBR,RCNT
  1.  S LTN=0 F  S LTN=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LTN)) Q:'LTN  D
  1.  . ;Q:$P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LTN,0),U,10)'=LA7V("IEN")
  1.  . D ORC
  1.  . S OBR(1)=$G(RCNT)+1,@GBL@(LA("I"))="OBR" ;initialize OBR segment
  1.  . S OBR(2)=LA("RUID") ; Remote UID
  1.  . S OBR(3)=LA("HUID") ; Host UID
  1.  . S LTN=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LTN,0),U),LRACC=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,.2),U),LTST=$P(^LAB(60,LTN,0),U) I $D(^LAB(60,LTN,64)) S NLTIEN=$P(^LAB(60,LTN,64),U) I NLTIEN=""!'$D(^LAM(NLTIEN,0)) K OBR Q
  1.  . S NTST=$P(^LAM(NLTIEN,0),U),NLT=$P(^LAM(NLTIEN,0),U,2)
  1.  . S OBR(4)=NLT_HLCOMP_NTST_HLCOMP_"99VA64"_HLCOMP_LTN_HLCOMP_LTST_HLCOMP_"99VA60" ; WKLD code/text/"99VA64"
  1.  . ;check to see if this TEST is setup in Auto-Instrument
  1.  . S OBR(7)=$$HLDATE^HLFNC($P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U)) ; Collection D/T
  1.  . ;S OBR(8)=$$HLDATE^HLFNC() ; DT Results Avail
  1.  . S OBR(12)=$P($G(^LR(LA("LRDFN"),.091)),U) ; Infection Warning
  1.  . S OBR(14)=$$HLDATE^HLFNC($P(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),0),U)) ; Lab Arrival Time
  1.  . ;S OBR(15)=$$GET1^DIQ(61,+$P(@SHP@(LA7V("IEN"),10,LA7V("S"),0),U,3)_",",.08)_HLSUB_$$GET1^DIQ(61,+$P(@SHP@(LA7V("IEN"),10,LA7V("S"),0),U,3)_",",.01)_HLSUB_"0070"
  1.  . S LA7CSI=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,5,0)) I LA7CSI'="" S LA7CS=$P(^(LA7CSI,0),U,2)
  1.  . S OBR(15)=$G(OBR(15))_HLCOMP_HLCOMP_$$GET1^DIQ(62,+$G(LA7CS)_",",.01)_HLCOMP_HLCOMP_HLCOMP ; Specimen source 
  1.  . S OBR(18)=LA("AUTO-INST") ; Placer Field #1 (HOST site)
  1.  . S $P(OBR(19),HLCOMP,7)=LA("RUID") ; Placer Field  #2
  1.  . S $P(OBR(27),HLCOMP,6)=$$GET1^DIQ(68.04,LTN_","_LRAN_","_LRAD_","_LRAA_",",1)
  1.  . F X=1:1:27 S @GBL@(LA("I"))=$G(@GBL@(LA("I")))_HLFS_$G(OBR(X))
  1.  . S LA("I")=$G(LA("I"))+1,RCNT=+$G(RCNT)+1
  1.  . D CHKTST
  1.  K LA7CS,LA7CSI
  1.  Q
  1. CHKTST ;
  1.  S X="LA7V HOST "_LA("SITE"),DIC=62.4,DIC(0)="ME" D ^DIC I Y>0 S TIEN=+Y,X=LTST,DIC="^LAB(62.4,"_TIEN_",3," D ^DIC I Y<1 D
  1.  . S DA(1)=TIEN,DIC("P")=$P(^DD(62.4,30,0),U,2),DIC(0)="L",DIC("DR")=".01///"_X_";6///"_NLT D ^DIC
  1.  Q