source: FOIAVistA/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7VOBX1.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.2 KB
Line 
1LA7VOBX1 ;DALOI/JMC - LAB OBX Segment message builder (CH subscript) cont'd; 5/25/00
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,61,63,64,71**;Sep 27, 1994
3 ;
4CH ; Observation/Result segment for "CH" subscript results.
5 ; Called by LA7VOBX
6 ;
7 N LA76304,LA7ALT,LA7DIV,LA7I,LA7RS,LA7X,LA7Y,X
8 ;
9 ; "CH" subscript requires a dataname
10 I '$G(LRSB) Q
11 ;
12 ; get result node from LR global.
13 S LA76304(0)=$G(^LR(LRDFN,LRSS,LRIDT,0))
14 S LA7RS=$P(LRSB,"^",2),LRSB=$P(LRSB,"^")
15 S LA7VAL=$G(^LR(LRDFN,LRSS,LRIDT,LRSB))
16 ; If previous results have been corrected then send corrected status
17 I LA7RS="",$P(LA7VAL,"^",10)=2 S LA7RS="C"
18 ;
19 ; Check if test is OK to send - (O)utput or (B)oth
20 S LA7X=$P(LA7VAL,"^",12)
21 I LA7X]"","BO"'[LA7X Q
22 I LA7X="",'$$OKTOSND^LA7VHLU1(LRSS,LRSB,+$P($P(LA7VAL,"^",3),"!",7)) Q
23 ;
24 ; If no result NLT or LOINC try to determine from file #60
25 S LA7X=$P(LA7VAL,"^",3)
26 I $P(LA7X,"!",2)=""!($P(LA7X,"!",3)="") S $P(LA7VAL,"^",3)=$$DEFCODE^LA7VHLU5(LRSS,LRSB,LA7X,$P(LA76304(0),"^",5))
27 ; No result NLT code - log error
28 I $P($P(LA7VAL,"^",3),"!",2)="" D
29 . N LA7X
30 . S LA7X="["_LRSB_"]"_$$GET1^DID(63.04,LRSB,"","LABEL")
31 . D CREATE^LA7LOG(36)
32 ;
33 ; something missing - No NLT code, etc.
34 I LA7VAL="" Q
35 ;
36 ; Check for missing units/reference ranges
37 S LA7X=$P(LA7VAL,"^",5)
38 ;
39 ; Results missing units, lookup in file #60
40 I $P(LA7X,"!",7)="" S $P(LA7X,"!",7)=$P($$REFUNIT^LA7VHLU1(LRSB,$P(LA76304(0),"^",5)),"^",3)
41 ;
42 ; If results missing reference ranges, use values from file #60.
43 I $P(LA7X,"!",2)="",$P(LA7X,"!",3)="",$P(LA7X,"!",11)="",$P(LA7X,"!",12)="" D
44 . S LA7Y=$$REFUNIT^LA7VHLU1(LRSB,$P(LA76304(0),"^",5))
45 . S $P(LA7X,"!",2)=$P(LA7Y,"^")
46 . S $P(LA7X,"!",3)=$P(LA7Y,"^",2)
47 . S $P(LA7X,"!",11)=$P(LA7Y,"^",6)
48 . S $P(LA7X,"!",12)=$P(LA7Y,"^",7)
49 ; Use therapeutic low/high if low/high missing.
50 I $P(LA7X,"!",2)="",$P(LA7X,"!",3)="" D
51 . S $P(LA7X,"!",2)=$P(LA7X,"!",11)
52 . S $P(LA7X,"!",3)=$P(LA7X,"!",12)
53 ;
54 ; Evaluate low/high reference ranges in case M code in these fields.
55 S:$G(SEX)="" SEX="M" S:$G(AGE)="" AGE=99
56 F LA7I=2,3 I $E($P(LA7X,"!",LA7I),1,3)="$S(" D
57 . S @("X="_$P(LA7X,"!",LA7I))
58 . S $P(LA7X,"!",LA7I)=X
59 ;
60 ; Put units/reference ranges back in variable LA7VAL
61 S $P(LA7VAL,"^",5)=LA7X
62 ;
63 ; Initialize OBX segment
64 S LA7OBX(0)="OBX"
65 S LA7OBX(1)=$$OBX1^LA7VOBX(.LA7OBXSN)
66 ;
67 ; Value type
68 ; If result is "cancel" or "comment" then data type is ST - string data
69 S LA7X=$S("canccomment"[$P(LA7VAL,"^"):1,1:0)
70 I LA7X S LA7OBX(2)="ST"
71 E S LA7OBX(2)=$$OBX2^LA7VOBX(63.04,LRSB)
72 ;
73 ; Observation identifer
74 ; build alternate code based on dataname from file #63 in case it's needed
75 S LA7X=$P(LA7VAL,"^",3)
76 S LA7ALT="CH"_LRSB_"^"_$$GET1^DID(63.04,LRSB,"","LABEL")_"^"_"99VA63"
77 S LA7OBX(3)=$$OBX3^LA7VOBX($P(LA7X,"!",2),$P(LA7X,"!",3),LA7ALT,LA7FS,LA7ECH)
78 ;
79 ; Test value
80 ; If DoD and "canc" then report "PL Cancelled" per Lab Interop ICD.
81 S LA7X=$P(LA7VAL,"^")
82 I LA7X'="canc",$$GET1^DID(63.04,LRSB,"","TYPE","","LA7ERR")="SET" D
83 . S LA7X=$$EXTERNAL^DILFD(63.04,LRSB,"",LA7X)
84 . I LA7X="" S LA7X=$P(LA7VAL,"^")
85 I $G(LA7NVAF)=1,LA7X="canc" S LA7X="PL Cancelled"
86 S LA7OBX(5)=$$OBX5^LA7VOBX(LA7X,LA7OBX(2),LA7FS,LA7ECH)
87 ;
88 ; Units
89 S LA7X=$P(LA7VAL,"^",5)
90 S LA7OBX(6)=$$OBX6^LA7VOBX($P(LA7X,"!",7),"",LA7FS,LA7ECH)
91 ;
92 ; Reference range
93 S LA7OBX(7)=$$OBX7^LA7VOBX($P(LA7X,"!",2),$P(LA7X,"!",3),LA7FS,LA7ECH)
94 ;
95 ; Abnormal flags
96 S LA7OBX(8)=$$OBX8^LA7VOBX($P(LA7VAL,"^",2))
97 ;
98 ; "P"artial or "F"inal results
99 S LA7X=$S("canccommentpending"[$P(LA7VAL,"^"):$P(LA7VAL,"^"),1:"F")
100 I LA7RS="C" S LA7X=LA7RS
101 S LA7OBX(11)=$$OBX11^LA7VOBX(LA7X)
102 ;
103 ; Observation date/time - collection date/time per HL7 standard
104 I $P(LA76304(0),"^") S LA7OBX(14)=$$OBX14^LA7VOBX($P(LA76304(0),"^"))
105 ;
106 S LA7DIV=$P(LA7VAL,"^",9)
107 I LA7DIV="",$$DIV4^XUSER(.LA7DIV,$P(LA7VAL,"^",4)) S LA7DIV=$O(LA7DIV(0))
108 ;
109 ; Facility that performed the testing
110 S LA7OBX(15)=$$OBX15^LA7VOBX(LA7DIV,LA7FS,LA7ECH)
111 ;
112 ; Person that verified the test
113 S LA7OBX(16)=$$OBX16^LA7VOBX($P(LA7VAL,"^",4),LA7DIV,LA7FS,LA7ECH)
114 ;
115 ; Observation method
116 S LA7X=$P($P(LA7VAL,"^",3),"!",4)
117 I LA7X S LA7OBX(17)=$$OBX17^LA7VOBX(LA7X,LA7FS,LA7ECH)
118 ;
119 ; Equipment entity identifier
120 I $L($P(LA7VAL,"^",11)) S LA7OBX(18)=$$OBX18^LA7VOBX($P(LA7VAL,"^",11),LA7FS,LA7ECH)
121 ;
122 D BUILDSEG^LA7VHLU(.LA7OBX,.LA7ARRAY,LA7FS)
123 ;
124 Q
Note: See TracBrowser for help on using the repository browser.