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

LA7VORM3.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ;
  1. OBR ;Observation Request segment for Lab Order
  1.  N LA760,LA764,LA7ALT,LA7DATA,LA7DUR,LA7DURU,LA7NLT,LA7X,LA7Y,LRACC,OBR,SPC
  1.  ;
  1.  S LA760=+$P(LA762801(0),"^",2)
  1.  S LA764=+$P($G(^LAB(60,LA760,64)),"^")
  1.  S LA7NLT=$P($G(^LAM(LA764,0)),"^",2)
  1.  ;
  1.  S OBR(0)="OBR"
  1.  S OBR(1)=$$OBR1^LA7VOBR(.LA7OBRSN) ;initialize OBR segment
  1.  ;
  1.  ; Remote UID
  1.  ;cmi/maw 5/11/10 changed back to original code to transform in Ensemble
  1.  ;S OBR(2)=$$OBR2^LA7VOBR(LA7UID,LA7FS,LA7ECH)  ;cmi/maw 3/10/2010 orig
  1.  S OBR(2)=$$OBR2^LA7VOBR(LA7UID,LA7FS,LA7ECH)  ;cmi/maw 7/1/2010 for order number
  1.  ;S OBR(2)=$$ORC2^LA7VORC($P(LA76802(.1),"^"),LA7FS,LA7ECH)  ;cmi/maw 3/10/2010 order number
  1.  ;
  1.  ; Universal service ID - check for non-VA code system
  1.  S LA7X=""
  1.  I $P(LA762801(5),"^")]"" S LA7X=$P(LA762801(5),"^",1)_"^"_$P(LA762801(5),"^",2)_"^"_$P(LA762801(5),"^",5)
  1.  S OBR(4)=$$OBR4^LA7VOBR(LA7NLT,LA760,LA7X,LA7FS,LA7ECH)
  1.  I $$UP^XLFSTR($P($G(LA7SCFG),U,2))["QUEST" D  ;cmi/maw 4/14/2010 for quest order number
  1.  . N LA7ORD,LA7ORDN
  1.  . S LA7ORD=$P(OBR(4),HLCOMP)
  1.  . S LA7ORDN=$P(OBR(4),HLCOMP,2)
  1.  . S OBR(4)=HLCOMP_HLCOMP_HLCOMP_LA7ORD_HLCOMP_LA7ORDN
  1.  ;
  1.  ; Collection date/time
  1.  S OBR(7)=$$OBR7^LA7VOBR($P(LA76802(3),"^"))
  1.  S OBR(7)=$P(OBR(7),"-")  ;cmi/maw 4/14/2010 remove timezone offset
  1.  ;
  1.  ; Collection end date/time
  1.  I $P(LA762801(2),U,4)=1 D
  1.  . S OBR(8)=$$OBR8^LA7VOBR($P(LA762801(2),U,5))
  1.  ;
  1.  ; Collection volume
  1.  I $P(LA762801(2),U)=1 D
  1.  . S OBR(9)=$$OBR9^LA7VOBR($P(LA762801(2),"^",2),$P(LA762801(2),"^",3),LA7FS,LA7ECH)
  1.  ;
  1.  ; Specimen action code
  1.  S OBR(11)=$$OBR11^LA7VOBR("P")
  1.  ;
  1.  ; Infection warning - patient info
  1.  S OBR(12)=$$OBR12^LA7VOBR(LRDFN,LA7FS,LA7ECH)
  1.  ;
  1.  ; Revelant clinical information
  1.  I LA762801(.1)'="" S OBR(13)=$$OBR13^LA7VOBR(LA762801(.1),LA7FS,LA7ECH)
  1.  ;
  1.  ; Lab Arrival Time
  1.  S OBR(14)=$$OBR14^LA7VOBR($P(LA76802(3),"^",3))
  1.  ;
  1.  ; Specimen source - handle non-HL7 coding system
  1.  S LA7X=""
  1.  I $P(LA762801(5),"^",3)'="" D
  1.  . F I=3,4 S $P(LA7X,"^",I-2)=$P(LA762801(5),"^",I)
  1.  . S $P(LA7X,"^",3)=$P(LA762801(5),"^",6)
  1.  I $P(LA762801(5),"^",7)'="" F I=7,8,9 S $P(LA7X,"^",I-2)=$P(LA762801(5),"^",I)
  1.  S OBR(15)=$$OBR15^LA7VOBR(+$P(LA762801(0),"^",3),+$P(LA76802(5),"^",2),LA7X,LA7FS,LA7ECH,$P(LA762801(0),"^",7))
  1.  ;
  1.  ; Ordering provider
  1.  K LA7X
  1.  S LA7X=$$FNDOLOC^LA7VHLU2(LA7UID)
  1.  S OBR(16)=$$ORC12^LA7VORC($P(LA76802(0),"^",8),$P(LA7X,"^",3),LA7FS,LA7ECH)
  1.  ;
  1.  ; Placer's field #1 (HOST site)
  1.  ;S OBR(18)="LA7V HOST "_SITE
  1.  ;cmi/maw 5/10/2010 changed so Order number is here, we will reverse them via Ensemble on inbound ORU^R01
  1.  S OBR(18)=$$ORC2^LA7VORC($P(LA76802(.1),"^"),LA7FS,LA7ECH)  ;cmi/maw 3/10/2010 order number
  1.  ;S OBR(18)=$$OBR2^LA7VOBR(LA7UID,LA7FS,LA7ECH)  ;cmi/maw 3/10/2010 acc # UID
  1.  ;cmi/maw 3/10/2009 lets put accession number here
  1.  ;
  1.  ; Placer's field #2
  1.  K LA7X
  1.  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
  1.  S OBR(19)=$$OBR19^LA7VOBR(.LA7X,LA7FS,LA7ECH)
  1.  ;
  1.  ; Test duration
  1.  S (LA7DUR,LA7DURU)=""
  1.  I $P(LA762801(2),"^",4) D
  1.  . S LA7DUR=$P(LA762801(2),"^",6) ; collection duration
  1.  . S LA7DURU=$P(LA762801(2),"^",7) ; duration units
  1.  ;
  1.  ; Test urgency
  1.  S LA76205=+$$GET1^DIQ(68.04,LA760_","_LRAN_","_LRAD_","_LRAA_",",1,"I")
  1.  S OBR(27)=$$OBR27^LA7VOBR(LA7DUR,LA7DURU,LA76205,LA7FS,LA7ECH)
  1.  ;
  1.  ; If sending to another VA then build OBR-34
  1.  I 'LA7NVAF S $P(OBR(34),HLCOMP,7)=$P($G(LA7V("HOST")),U)
  1.  ;
  1.  D BUILDSEG^LA7VHLU(.OBR,.LA7DATA,LA7FS)
  1.  D FILESEG^LA7VHLU(GBL,.LA7DATA)
  1.  D FILE6249^LA7VHLU(LA76249,.LA7DATA)
  1.  Q
  1.  ;
  1. OBX ; Build OBX segments with required info if any.
  1.  ;
  1.  N LA74,LA7DUR,LA7DURU
  1.  ;
  1.  ; Collecting facility
  1.  S LA74=$P(LA7629(0),"^",2)
  1.  S LA7OBXSN=0
  1.  ;
  1.  ; Patient height
  1.  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)
  1.  ;
  1.  ; Patient weight
  1.  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)
  1.  ;
  1.  ; Collection duration
  1.  S (LA7DUR,LA7DURU)=""
  1.  I $P(LA762801(2),"^",4) D
  1.  . S LA7DUR=$P(LA762801(2),"^",6) ; collection duration
  1.  . S LA7DURU=$P(LA762801(2),"^",7) ; duration units
  1.  . D SPDUR^LA7VORM2($P(LA762801(2),"^",6),$P(LA762801(2),"^",7),$P(LA762801(2),"^",12),LA74,.LA7OBXSN,.LRI,LA7FS,LA7ECH,LA76249)
  1.  ;
  1.  ; Collection volume
  1.  I $P(LA762801(2),"^",2) D
  1.  . D SPCV^LA7VORM2($P(LA762801(2),"^",2),$P(LA762801(2),"^",3),$P(LA762801(2),"^",11),LA74,.LA7OBXSN,.LRI,LA7FS,LA7ECH,LA76249)
  1.  ;
  1.  ; Specimen weight
  1.  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)
  1.  ;
  1.  ; Check for anatomic/surigal path subscripts
  1.  I "SP^CY^AU^EM"[$P($G(^LRO(68,LRAA,0)),"^",2) D AP
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. AP ; Observation/Result segment for Lab AP Results sent with Order Message
  1.  ;
  1.  N LA7DATA,LA7IDT,LRIDT,LRSB,LRSS
  1.  ;
  1.  S LRSS=$P($G(^LRO(68,LRAA,0)),"^",2)
  1.  S (LA7IDT,LRIDT)=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),"^",5)
  1.  D APORM^LA7VORU2
  1.  Q