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