LA7VORM3 ;VA/DALOI/JMC - LAB ORM (Order) message builder cont'd ;JUL 06, 2010 3:14 PM
;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64,1027**;NOV 01, 1997;Build 9
;
;
OBR ;Observation Request segment for Lab Order
N LA760,LA764,LA7ALT,LA7DATA,LA7DUR,LA7DURU,LA7NLT,LA7X,LA7Y,LRACC,OBR,SPC
;
S LA760=+$P(LA762801(0),"^",2)
S LA764=+$P($G(^LAB(60,LA760,64)),"^")
S LA7NLT=$P($G(^LAM(LA764,0)),"^",2)
;
S OBR(0)="OBR"
S OBR(1)=$$OBR1^LA7VOBR(.LA7OBRSN) ;initialize OBR segment
;
; Remote UID
;cmi/maw 5/11/10 changed back to original code to transform in Ensemble
;S OBR(2)=$$OBR2^LA7VOBR(LA7UID,LA7FS,LA7ECH) ;cmi/maw 3/10/2010 orig
S OBR(2)=$$OBR2^LA7VOBR(LA7UID,LA7FS,LA7ECH) ;cmi/maw 7/1/2010 for order number
;S OBR(2)=$$ORC2^LA7VORC($P(LA76802(.1),"^"),LA7FS,LA7ECH) ;cmi/maw 3/10/2010 order number
;
; Universal service ID - check for non-VA code system
S LA7X=""
I $P(LA762801(5),"^")]"" S LA7X=$P(LA762801(5),"^",1)_"^"_$P(LA762801(5),"^",2)_"^"_$P(LA762801(5),"^",5)
S OBR(4)=$$OBR4^LA7VOBR(LA7NLT,LA760,LA7X,LA7FS,LA7ECH)
I $$UP^XLFSTR($P($G(LA7SCFG),U,2))["QUEST" D ;cmi/maw 4/14/2010 for quest order number
. N LA7ORD,LA7ORDN
. S LA7ORD=$P(OBR(4),HLCOMP)
. S LA7ORDN=$P(OBR(4),HLCOMP,2)
. S OBR(4)=HLCOMP_HLCOMP_HLCOMP_LA7ORD_HLCOMP_LA7ORDN
;
; Collection date/time
S OBR(7)=$$OBR7^LA7VOBR($P(LA76802(3),"^"))
S OBR(7)=$P(OBR(7),"-") ;cmi/maw 4/14/2010 remove timezone offset
;
; Collection end date/time
I $P(LA762801(2),U,4)=1 D
. S OBR(8)=$$OBR8^LA7VOBR($P(LA762801(2),U,5))
;
; Collection volume
I $P(LA762801(2),U)=1 D
. S OBR(9)=$$OBR9^LA7VOBR($P(LA762801(2),"^",2),$P(LA762801(2),"^",3),LA7FS,LA7ECH)
;
; Specimen action code
S OBR(11)=$$OBR11^LA7VOBR("P")
;
; Infection warning - patient info
S OBR(12)=$$OBR12^LA7VOBR(LRDFN,LA7FS,LA7ECH)
;
; Revelant clinical information
I LA762801(.1)'="" S OBR(13)=$$OBR13^LA7VOBR(LA762801(.1),LA7FS,LA7ECH)
;
; Lab Arrival Time
S OBR(14)=$$OBR14^LA7VOBR($P(LA76802(3),"^",3))
;
; Specimen source - handle non-HL7 coding system
S LA7X=""
I $P(LA762801(5),"^",3)'="" D
. F I=3,4 S $P(LA7X,"^",I-2)=$P(LA762801(5),"^",I)
. S $P(LA7X,"^",3)=$P(LA762801(5),"^",6)
I $P(LA762801(5),"^",7)'="" F I=7,8,9 S $P(LA7X,"^",I-2)=$P(LA762801(5),"^",I)
S OBR(15)=$$OBR15^LA7VOBR(+$P(LA762801(0),"^",3),+$P(LA76802(5),"^",2),LA7X,LA7FS,LA7ECH,$P(LA762801(0),"^",7))
;
; Ordering provider
K LA7X
S LA7X=$$FNDOLOC^LA7VHLU2(LA7UID)
S OBR(16)=$$ORC12^LA7VORC($P(LA76802(0),"^",8),$P(LA7X,"^",3),LA7FS,LA7ECH)
;
; Placer's field #1 (HOST site)
;S OBR(18)="LA7V HOST "_SITE
;cmi/maw 5/10/2010 changed so Order number is here, we will reverse them via Ensemble on inbound ORU^R01
S OBR(18)=$$ORC2^LA7VORC($P(LA76802(.1),"^"),LA7FS,LA7ECH) ;cmi/maw 3/10/2010 order number
;S OBR(18)=$$OBR2^LA7VOBR(LA7UID,LA7FS,LA7ECH) ;cmi/maw 3/10/2010 acc # UID
;cmi/maw 3/10/2009 lets put accession number here
;
; Placer's field #2
K LA7X
S LA7X(3)=LRAA,LA7X(4)=LRAD,LA7X(5)=LRAN,LA7X(6)=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,.2),U),LA7X(7)=LA7UID
S OBR(19)=$$OBR19^LA7VOBR(.LA7X,LA7FS,LA7ECH)
;
; Test duration
S (LA7DUR,LA7DURU)=""
I $P(LA762801(2),"^",4) D
. S LA7DUR=$P(LA762801(2),"^",6) ; collection duration
. S LA7DURU=$P(LA762801(2),"^",7) ; duration units
;
; Test urgency
S LA76205=+$$GET1^DIQ(68.04,LA760_","_LRAN_","_LRAD_","_LRAA_",",1,"I")
S OBR(27)=$$OBR27^LA7VOBR(LA7DUR,LA7DURU,LA76205,LA7FS,LA7ECH)
;
; If sending to another VA then build OBR-34
I 'LA7NVAF S $P(OBR(34),HLCOMP,7)=$P($G(LA7V("HOST")),U)
;
D BUILDSEG^LA7VHLU(.OBR,.LA7DATA,LA7FS)
D FILESEG^LA7VHLU(GBL,.LA7DATA)
D FILE6249^LA7VHLU(LA76249,.LA7DATA)
Q
;
OBX ; Build OBX segments with required info if any.
;
N LA74,LA7DUR,LA7DURU
;
; Collecting facility
S LA74=$P(LA7629(0),"^",2)
S LA7OBXSN=0
;
; Patient height
I $P(LA762801(1),"^") D PTHT^LA7VORM2($P(LA762801(1),"^",2),$P(LA762801(1),"^",3),$P(LA762801(1),"^",7),LA74,.LA7OBXSN,.LRI,LA7FS,LA7ECH,LA76249)
;
; Patient weight
I $P(LA762801(1),"^",4) D PTWT^LA7VORM2($P(LA762801(1),"^",5),$P(LA762801(1),"^",6),$P(LA762801(1),"^",8),LA74,.LA7OBXSN,.LRI,LA7FS,LA7ECH,LA76249)
;
; Collection duration
S (LA7DUR,LA7DURU)=""
I $P(LA762801(2),"^",4) D
. S LA7DUR=$P(LA762801(2),"^",6) ; collection duration
. S LA7DURU=$P(LA762801(2),"^",7) ; duration units
. D SPDUR^LA7VORM2($P(LA762801(2),"^",6),$P(LA762801(2),"^",7),$P(LA762801(2),"^",12),LA74,.LA7OBXSN,.LRI,LA7FS,LA7ECH,LA76249)
;
; Collection volume
I $P(LA762801(2),"^",2) D
. D SPCV^LA7VORM2($P(LA762801(2),"^",2),$P(LA762801(2),"^",3),$P(LA762801(2),"^",11),LA74,.LA7OBXSN,.LRI,LA7FS,LA7ECH,LA76249)
;
; Specimen weight
I $P(LA762801(2),"^",8) D SPWT^LA7VORM2($P(LA762801(2),"^",9),$P(LA762801(2),"^",10),LA7DUR_LA7DURU,$P(LA762801(2),"^",13),LA74,.LA7OBXSN,.LRI,LA7FS,LA7ECH,LA76249)
;
; Check for anatomic/surigal path subscripts
I "SP^CY^AU^EM"[$P($G(^LRO(68,LRAA,0)),"^",2) D AP
;
Q
;
;
AP ; Observation/Result segment for Lab AP Results sent with Order Message
;
N LA7DATA,LA7IDT,LRIDT,LRSB,LRSS
;
S LRSS=$P($G(^LRO(68,LRAA,0)),"^",2)
S (LA7IDT,LRIDT)=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),"^",5)
D APORM^LA7VORU2
Q
LA7VORM3 ;VA/DALOI/JMC - LAB ORM (Order) message builder cont'd ;JUL 06, 2010 3:14 PM
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64,1027**;NOV 01, 1997;Build 9
+2 ;
+3 ;
OBR ;Observation Request segment for Lab Order
+1 NEW LA760,LA764,LA7ALT,LA7DATA,LA7DUR,LA7DURU,LA7NLT,LA7X,LA7Y,LRACC,OBR,SPC
+2 ;
+3 SET LA760=+$PIECE(LA762801(0),"^",2)
+4 SET LA764=+$PIECE($GET(^LAB(60,LA760,64)),"^")
+5 SET LA7NLT=$PIECE($GET(^LAM(LA764,0)),"^",2)
+6 ;
+7 SET OBR(0)="OBR"
+8 ;initialize OBR segment
SET OBR(1)=$$OBR1^LA7VOBR(.LA7OBRSN)
+9 ;
+10 ; Remote UID
+11 ;cmi/maw 5/11/10 changed back to original code to transform in Ensemble
+12 ;S OBR(2)=$$OBR2^LA7VOBR(LA7UID,LA7FS,LA7ECH) ;cmi/maw 3/10/2010 orig
+13 ;cmi/maw 7/1/2010 for order number
SET OBR(2)=$$OBR2^LA7VOBR(LA7UID,LA7FS,LA7ECH)
+14 ;S OBR(2)=$$ORC2^LA7VORC($P(LA76802(.1),"^"),LA7FS,LA7ECH) ;cmi/maw 3/10/2010 order number
+15 ;
+16 ; Universal service ID - check for non-VA code system
+17 SET LA7X=""
+18 IF $PIECE(LA762801(5),"^")]""
SET LA7X=$PIECE(LA762801(5),"^",1)_"^"_$PIECE(LA762801(5),"^",2)_"^"_$PIECE(LA762801(5),"^",5)
+19 SET OBR(4)=$$OBR4^LA7VOBR(LA7NLT,LA760,LA7X,LA7FS,LA7ECH)
+20 ;cmi/maw 4/14/2010 for quest order number
IF $$UP^XLFSTR($PIECE($GET(LA7SCFG),U,2))["QUEST"
Begin DoDot:1
+21 NEW LA7ORD,LA7ORDN
+22 SET LA7ORD=$PIECE(OBR(4),HLCOMP)
+23 SET LA7ORDN=$PIECE(OBR(4),HLCOMP,2)
+24 SET OBR(4)=HLCOMP_HLCOMP_HLCOMP_LA7ORD_HLCOMP_LA7ORDN
End DoDot:1
+25 ;
+26 ; Collection date/time
+27 SET OBR(7)=$$OBR7^LA7VOBR($PIECE(LA76802(3),"^"))
+28 ;cmi/maw 4/14/2010 remove timezone offset
SET OBR(7)=$PIECE(OBR(7),"-")
+29 ;
+30 ; Collection end date/time
+31 IF $PIECE(LA762801(2),U,4)=1
Begin DoDot:1
+32 SET OBR(8)=$$OBR8^LA7VOBR($PIECE(LA762801(2),U,5))
End DoDot:1
+33 ;
+34 ; Collection volume
+35 IF $PIECE(LA762801(2),U)=1
Begin DoDot:1
+36 SET OBR(9)=$$OBR9^LA7VOBR($PIECE(LA762801(2),"^",2),$PIECE(LA762801(2),"^",3),LA7FS,LA7ECH)
End DoDot:1
+37 ;
+38 ; Specimen action code
+39 SET OBR(11)=$$OBR11^LA7VOBR("P")
+40 ;
+41 ; Infection warning - patient info
+42 SET OBR(12)=$$OBR12^LA7VOBR(LRDFN,LA7FS,LA7ECH)
+43 ;
+44 ; Revelant clinical information
+45 IF LA762801(.1)'=""
SET OBR(13)=$$OBR13^LA7VOBR(LA762801(.1),LA7FS,LA7ECH)
+46 ;
+47 ; Lab Arrival Time
+48 SET OBR(14)=$$OBR14^LA7VOBR($PIECE(LA76802(3),"^",3))
+49 ;
+50 ; Specimen source - handle non-HL7 coding system
+51 SET LA7X=""
+52 IF $PIECE(LA762801(5),"^",3)'=""
Begin DoDot:1
+53 FOR I=3,4
SET $PIECE(LA7X,"^",I-2)=$PIECE(LA762801(5),"^",I)
+54 SET $PIECE(LA7X,"^",3)=$PIECE(LA762801(5),"^",6)
End DoDot:1
+55 IF $PIECE(LA762801(5),"^",7)'=""
FOR I=7,8,9
SET $PIECE(LA7X,"^",I-2)=$PIECE(LA762801(5),"^",I)
+56 SET OBR(15)=$$OBR15^LA7VOBR(+$PIECE(LA762801(0),"^",3),+$PIECE(LA76802(5),"^",2),LA7X,LA7FS,LA7ECH,$PIECE(LA762801(0),"^",7))
+57 ;
+58 ; Ordering provider
+59 KILL LA7X
+60 SET LA7X=$$FNDOLOC^LA7VHLU2(LA7UID)
+61 SET OBR(16)=$$ORC12^LA7VORC($PIECE(LA76802(0),"^",8),$PIECE(LA7X,"^",3),LA7FS,LA7ECH)
+62 ;
+63 ; Placer's field #1 (HOST site)
+64 ;S OBR(18)="LA7V HOST "_SITE
+65 ;cmi/maw 5/10/2010 changed so Order number is here, we will reverse them via Ensemble on inbound ORU^R01
+66 ;cmi/maw 3/10/2010 order number
SET OBR(18)=$$ORC2^LA7VORC($PIECE(LA76802(.1),"^"),LA7FS,LA7ECH)
+67 ;S OBR(18)=$$OBR2^LA7VOBR(LA7UID,LA7FS,LA7ECH) ;cmi/maw 3/10/2010 acc # UID
+68 ;cmi/maw 3/10/2009 lets put accession number here
+69 ;
+70 ; Placer's field #2
+71 KILL LA7X
+72 SET LA7X(3)=LRAA
SET LA7X(4)=LRAD
SET LA7X(5)=LRAN
SET LA7X(6)=$PIECE(^LRO(68,LRAA,1,LRAD,1,LRAN,.2),U)
SET LA7X(7)=LA7UID
+73 SET OBR(19)=$$OBR19^LA7VOBR(.LA7X,LA7FS,LA7ECH)
+74 ;
+75 ; Test duration
+76 SET (LA7DUR,LA7DURU)=""
+77 IF $PIECE(LA762801(2),"^",4)
Begin DoDot:1
+78 ; collection duration
SET LA7DUR=$PIECE(LA762801(2),"^",6)
+79 ; duration units
SET LA7DURU=$PIECE(LA762801(2),"^",7)
End DoDot:1
+80 ;
+81 ; Test urgency
+82 SET LA76205=+$$GET1^DIQ(68.04,LA760_","_LRAN_","_LRAD_","_LRAA_",",1,"I")
+83 SET OBR(27)=$$OBR27^LA7VOBR(LA7DUR,LA7DURU,LA76205,LA7FS,LA7ECH)
+84 ;
+85 ; If sending to another VA then build OBR-34
+86 IF 'LA7NVAF
SET $PIECE(OBR(34),HLCOMP,7)=$PIECE($GET(LA7V("HOST")),U)
+87 ;
+88 DO BUILDSEG^LA7VHLU(.OBR,.LA7DATA,LA7FS)
+89 DO FILESEG^LA7VHLU(GBL,.LA7DATA)
+90 DO FILE6249^LA7VHLU(LA76249,.LA7DATA)
+91 QUIT
+92 ;
OBX ; Build OBX segments with required info if any.
+1 ;
+2 NEW LA74,LA7DUR,LA7DURU
+3 ;
+4 ; Collecting facility
+5 SET LA74=$PIECE(LA7629(0),"^",2)
+6 SET LA7OBXSN=0
+7 ;
+8 ; Patient height
+9 IF $PIECE(LA762801(1),"^")
DO PTHT^LA7VORM2($PIECE(LA762801(1),"^",2),$PIECE(LA762801(1),"^",3),$PIECE(LA762801(1),"^",7),LA74,.LA7OBXSN,.LRI,LA7FS,LA7ECH,LA76249)
+10 ;
+11 ; Patient weight
+12 IF $PIECE(LA762801(1),"^",4)
DO PTWT^LA7VORM2($PIECE(LA762801(1),"^",5),$PIECE(LA762801(1),"^",6),$PIECE(LA762801(1),"^",8),LA74,.LA7OBXSN,.LRI,LA7FS,LA7ECH,LA76249)
+13 ;
+14 ; Collection duration
+15 SET (LA7DUR,LA7DURU)=""
+16 IF $PIECE(LA762801(2),"^",4)
Begin DoDot:1
+17 ; collection duration
SET LA7DUR=$PIECE(LA762801(2),"^",6)
+18 ; duration units
SET LA7DURU=$PIECE(LA762801(2),"^",7)
+19 DO SPDUR^LA7VORM2($PIECE(LA762801(2),"^",6),$PIECE(LA762801(2),"^",7),$PIECE(LA762801(2),"^",12),LA74,.LA7OBXSN,.LRI,LA7FS,LA7ECH,LA76249)
End DoDot:1
+20 ;
+21 ; Collection volume
+22 IF $PIECE(LA762801(2),"^",2)
Begin DoDot:1
+23 DO SPCV^LA7VORM2($PIECE(LA762801(2),"^",2),$PIECE(LA762801(2),"^",3),$PIECE(LA762801(2),"^",11),LA74,.LA7OBXSN,.LRI,LA7FS,LA7ECH,LA76249)
End DoDot:1
+24 ;
+25 ; Specimen weight
+26 IF $PIECE(LA762801(2),"^",8)
DO SPWT^LA7VORM2($PIECE(LA762801(2),"^",9),$PIECE(LA762801(2),"^",10),LA7DUR_LA7DURU,$PIECE(LA762801(2),"^",13),LA74,.LA7OBXSN,.LRI,LA7FS,LA7ECH,LA76249)
+27 ;
+28 ; Check for anatomic/surigal path subscripts
+29 IF "SP^CY^AU^EM"[$PIECE($GET(^LRO(68,LRAA,0)),"^",2)
DO AP
+30 ;
+31 QUIT
+32 ;
+33 ;
AP ; Observation/Result segment for Lab AP Results sent with Order Message
+1 ;
+2 NEW LA7DATA,LA7IDT,LRIDT,LRSB,LRSS
+3 ;
+4 SET LRSS=$PIECE($GET(^LRO(68,LRAA,0)),"^",2)
+5 SET (LA7IDT,LRIDT)=$PIECE($GET(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),"^",5)
+6 DO APORM^LA7VORU2
+7 QUIT
