source: FOIAVistA/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7VORM3.m@ 1806

Last change on this file since 1806 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.1 KB
Line 
1LA7VORM3 ;DALOI/JMC - LAB ORM (Order) message builder cont'd ; 11-21-986
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64**;Sep 27, 1994
3 ;
4 ;
5OBR ;Observation Request segment for Lab Order
6 N LA760,LA764,LA7ALT,LA7DATA,LA7DUR,LA7DURU,LA7NLT,LA7X,LA7Y,LRACC,OBR,SPC
7 ;
8 S LA760=+$P(LA762801(0),"^",2)
9 S LA764=+$P($G(^LAB(60,LA760,64)),"^")
10 S LA7NLT=$P($G(^LAM(LA764,0)),"^",2)
11 ;
12 S OBR(0)="OBR"
13 S OBR(1)=$$OBR1^LA7VOBR(.LA7OBRSN) ;initialize OBR segment
14 ;
15 ; Remote UID
16 S OBR(2)=$$OBR2^LA7VOBR(LA7UID,LA7FS,LA7ECH)
17 ;
18 ; Universal service ID - check for non-VA code system
19 S LA7X=""
20 I $P(LA762801(5),"^")]"" S LA7X=$P(LA762801(5),"^",1)_"^"_$P(LA762801(5),"^",2)_"^"_$P(LA762801(5),"^",5)
21 S OBR(4)=$$OBR4^LA7VOBR(LA7NLT,LA760,LA7X,LA7FS,LA7ECH)
22 ;
23 ; Collection date/time
24 S OBR(7)=$$OBR7^LA7VOBR($P(LA76802(3),"^"))
25 ;
26 ; Collection end date/time
27 I $P(LA762801(2),U,4)=1 D
28 . S OBR(8)=$$OBR8^LA7VOBR($P(LA762801(2),U,5))
29 ;
30 ; Collection volume
31 I $P(LA762801(2),U)=1 D
32 . S OBR(9)=$$OBR9^LA7VOBR($P(LA762801(2),"^",2),$P(LA762801(2),"^",3),LA7FS,LA7ECH)
33 ;
34 ; Specimen action code
35 S OBR(11)=$$OBR11^LA7VOBR("P")
36 ;
37 ; Infection warning - patient info
38 S OBR(12)=$$OBR12^LA7VOBR(LRDFN,LA7FS,LA7ECH)
39 ;
40 ; Revelant clinical information
41 I LA762801(.1)'="" S OBR(13)=$$OBR13^LA7VOBR(LA762801(.1),LA7FS,LA7ECH)
42 ;
43 ; Lab Arrival Time
44 S OBR(14)=$$OBR14^LA7VOBR($P(LA76802(3),"^",3))
45 ;
46 ; Specimen source - handle non-HL7 coding system
47 S LA7X=""
48 I $P(LA762801(5),"^",3)'="" D
49 . F I=3,4 S $P(LA7X,"^",I-2)=$P(LA762801(5),"^",I)
50 . S $P(LA7X,"^",3)=$P(LA762801(5),"^",6)
51 I $P(LA762801(5),"^",7)'="" F I=7,8,9 S $P(LA7X,"^",I-2)=$P(LA762801(5),"^",I)
52 S OBR(15)=$$OBR15^LA7VOBR(+$P(LA762801(0),"^",3),+$P(LA76802(5),"^",2),LA7X,LA7FS,LA7ECH,$P(LA762801(0),"^",7))
53 ;
54 ; Ordering provider
55 K LA7X
56 S LA7X=$$FNDOLOC^LA7VHLU2(LA7UID)
57 S OBR(16)=$$ORC12^LA7VORC($P(LA76802(0),"^",8),$P(LA7X,"^",3),LA7FS,LA7ECH)
58 ;
59 ; Placer's field #1 (HOST site)
60 S OBR(18)="LA7V HOST "_SITE
61 ;
62 ; Placer's field #2
63 K LA7X
64 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
65 S OBR(19)=$$OBR19^LA7VOBR(.LA7X,LA7FS,LA7ECH)
66 ;
67 ; Test duration
68 S (LA7DUR,LA7DURU)=""
69 I $P(LA762801(2),"^",4) D
70 . S LA7DUR=$P(LA762801(2),"^",6) ; collection duration
71 . S LA7DURU=$P(LA762801(2),"^",7) ; duration units
72 ;
73 ; Test urgency
74 S LA76205=+$$GET1^DIQ(68.04,LA760_","_LRAN_","_LRAD_","_LRAA_",",1,"I")
75 S OBR(27)=$$OBR27^LA7VOBR(LA7DUR,LA7DURU,LA76205,LA7FS,LA7ECH)
76 ;
77 ; If sending to another VA then build OBR-34
78 I 'LA7NVAF S $P(OBR(34),HLCOMP,7)=$P($G(LA7V("HOST")),U)
79 ;
80 D BUILDSEG^LA7VHLU(.OBR,.LA7DATA,LA7FS)
81 D FILESEG^LA7VHLU(GBL,.LA7DATA)
82 D FILE6249^LA7VHLU(LA76249,.LA7DATA)
83 Q
84 ;
85OBX ; Build OBX segments with required info if any.
86 ;
87 N LA74,LA7DUR,LA7DURU
88 ;
89 ; Collecting facility
90 S LA74=$P(LA7629(0),"^",2)
91 S LA7OBXSN=0
92 ;
93 ; Patient height
94 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)
95 ;
96 ; Patient weight
97 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)
98 ;
99 ; Collection duration
100 S (LA7DUR,LA7DURU)=""
101 I $P(LA762801(2),"^",4) D
102 . S LA7DUR=$P(LA762801(2),"^",6) ; collection duration
103 . S LA7DURU=$P(LA762801(2),"^",7) ; duration units
104 . D SPDUR^LA7VORM2($P(LA762801(2),"^",6),$P(LA762801(2),"^",7),$P(LA762801(2),"^",12),LA74,.LA7OBXSN,.LRI,LA7FS,LA7ECH,LA76249)
105 ;
106 ; Collection volume
107 I $P(LA762801(2),"^",2) D
108 . D SPCV^LA7VORM2($P(LA762801(2),"^",2),$P(LA762801(2),"^",3),$P(LA762801(2),"^",11),LA74,.LA7OBXSN,.LRI,LA7FS,LA7ECH,LA76249)
109 ;
110 ; Specimen weight
111 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)
112 ;
113 ; Check for anatomic/surigal path subscripts
114 I "SP^CY^AU^EM"[$P($G(^LRO(68,LRAA,0)),"^",2) D AP
115 ;
116 Q
117 ;
118 ;
119AP ; Observation/Result segment for Lab AP Results sent with Order Message
120 ;
121 N LA7DATA,LA7IDT,LRIDT,LRSB,LRSS
122 ;
123 S LRSS=$P($G(^LRO(68,LRAA,0)),"^",2)
124 S (LA7IDT,LRIDT)=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),"^",5)
125 D APORM^LA7VORU2
126 Q
Note: See TracBrowser for help on using the repository browser.