source: WorldVistAEHR/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7VOBX3.m@ 841

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

initial load of WorldVistAEHR
File size: 5.9 KB
Line 
1LA7VOBX3 ;DALOI/JMC - LAB OBX Segment message builder (MI subscripts) cont'd ; 5/26/00
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64**;Sep 27, 1994
3 ;
4MI ; Build OBX segments for results that are microbiology subscript.
5 ; Called by LA7VOBX
6 ;
7 N I,LA761,LA76305,LA7ALT,LA7ALTCS,LA7CODE,LA7DIV,LA7IENS,LA7LOINC,LA7NLT,LA7OBX,LA7ORS,LA7PARNT,LA7SAVID,LA7SUBFL,LA7VAL,LA7VERP
8 ;
9 I $P(LRIDT,",",2) S LRIDT(2)=$P(LRIDT,",",2),LRIDT(3)=$P(LRIDT,",",3),LRIDT=$P(LRIDT,",")
10 ;
11 I '$D(^LR(LRDFN,LRSS,LRIDT)) Q
12 ;
13 F I=0,1,5,8,11,16 S LA76305(I)=$G(^LR(LRDFN,LRSS,LRIDT,I))
14 ;
15 S (LA7ALT,LA7ALTCS,LA7CODE,LA7ID,LA7LOINC,LA7NLT,LA7ORS,LA7SAVID,LA7SUBFL,LA7VAL,LA7VERP)=""
16 ;
17 ; Specimen topography
18 S LA761=$P(LA76305(0),"^",5)
19 ; Default codes
20 S LA7CODE=$$DEFCODE^LA7VHLU5(LRSS,LRSB,LA7CODE,LA761)
21 ;
22 ; Gram stain
23 I LRSB=11.6 D
24 . N LA7ERR
25 . S LA7VERP=$P(LA76305(1),"^",3)
26 . S LA7ORS=$P(LA76305(1),"^",2)
27 . S LA7OBX(2)=$$OBX2^LA7VOBX(63.05,11.6)
28 . S LA7IENS=LRIDT(2)_","_LRIDT_","_LRDFN_","
29 . S LA7VAL=$$GET1^DIQ(63.29,LA7IENS,.01,"","LA7ERR")
30 . ; Setup DoD special coding system
31 . I LA7NVAF=1,$P(LA7CODE,"!",2) S LA7ALTCS="99VA64MG"
32 ;
33 ; Micro organism
34 I $P(LRSB,",")=12 D
35 . S LA7VERP=$P(LA76305(1),"^",3)
36 . S LA7ORS=$P(LA76305(1),"^",2)
37 . S LA7SUBFL=63.3
38 . ; Working on colony count
39 . I $P(LRSB,",",2)=1 D CC Q
40 . ; Working on organism
41 . I $G(LRIDT(3))="" D ORG Q
42 . ; Working on susceptibilities
43 . I $P(LA76305(1),"^",4) S LA7VERP=$P(LA76305(1),"^",4)
44 . D MIC
45 ;
46 ; Parasite organism
47 I $P(LRSB,",")=16 D
48 . S LA7ORS=$P(LA76305(5),"^",2)
49 . S LA7VERP=$P(LA76305(5),"^",3)
50 . ; Working on organism
51 . S LA7SUBFL=63.34 D ORG
52 ;
53 ; Mycology organism
54 I $P(LRSB,",")=20 D
55 . S LA7ORS=$P(LA76305(8),"^",2)
56 . S LA7VERP=$P(LA76305(8),"^",3)
57 . S LA7SUBFL=63.37
58 . ; Working on colony count
59 . I $P(LRSB,",",2)=1 D CC Q
60 . ; Working on organism
61 . D ORG
62 ;
63 ; Acid Fast stain
64 I LRSB=24 D
65 . N LA7ERR
66 . S LA7VERP=$P(LA76305(11),"^",3)
67 . S LA7ORS=$P(LA76305(11),"^",2)
68 . S LA7OBX(2)=$$OBX2^LA7VOBX(63.05,24)
69 . S LA7IENS=LRIDT_","_LRDFN_","
70 . S LA7VAL=$$GET1^DIQ(63.05,LA7IENS,24,"","LA7ERR")
71 ;
72 ; Acid Fast stain quantity
73 I LRSB=25 D
74 . N LA7ERR
75 . S LA7VERP=$P(LA76305(11),"^",3)
76 . S LA7ORS=$P(LA76305(11),"^",2)
77 . S LA7OBX(2)=$$OBX2^LA7VOBX(63.05,25)
78 . S LA7IENS=LRIDT_","_LRDFN_","
79 . S LA7VAL=$$GET1^DIQ(63.05,LA7IENS,25,"","LA7ERR")
80 ;
81 ; TB organism
82 I $P(LRSB,",")=26 D
83 . S LA7ORS=$P(LA76305(11),"^",2)
84 . S LA7VERP=$P(LA76305(11),"^",5)
85 . S LA7SUBFL=63.39
86 . ; Working on organism
87 . I $G(LRIDT(3))="" D ORG Q
88 . ; Working on susceptibilities
89 . D MIC
90 ;
91 ; Virology virus
92 I $P(LRSB,",")=36 D
93 . S LA7ORS=$P(LA76305(16),"^",2)
94 . S LA7VERP=$P(LA76305(16),"^",3)
95 . ; Working on virus
96 . S LA7SUBFL=63.43
97 . D ORG
98 ;
99 D GEN
100 ;
101 Q
102 ;
103 ;
104CC ; Organism's Colony count
105 ; If "CFU/ml" found then move units to OBX-6 (Units).
106 N LA7X
107 ;
108 S LA7ID=$P(LRSB,",")_"-"_LRIDT(2)
109 S LA7IENS=LRIDT(2)_","_LRIDT_","_LRDFN_","
110 S LA7OBX(2)=$$OBX2^LA7VOBX(LA7SUBFL,1)
111 S LA7VAL=$$GET1^DIQ(LA7SUBFL,LA7IENS,1)
112 S LA7X=$$UP^XLFSTR(LA7VAL)
113 I LA7X["CFU/ML" D
114 . S LA7OBX(6)="CFU/ml"
115 . S LA7X("CFU/ml")="",LA7X("CFU/ML")=""
116 . S LA7VAL=$$REPLACE^XLFSTR(LA7VAL,.LA7X)
117 ;
118 ; Setup DoD special coding system
119 I LA7NVAF=1,$P(LA7CODE,"!",2) S LA7ALTCS="99VA64MC"
120 ;
121 Q
122 ;
123 ;
124ORG ; Organism
125 ;
126 S LA7ID=LRSB_"-"_LRIDT(2)
127 S LA7OBX(2)=$$OBX2^LA7VOBX(LA7SUBFL,.01)
128 S LA7IENS=LRIDT(2)_","_LRIDT_","_LRDFN_","
129 S LA7VAL=$$GET1^DIQ(LA7SUBFL,LA7IENS,.01)
130 ;
131 ; Check for Snomed coding
132 S X=$$GET1^DIQ(LA7SUBFL,LA7IENS,".01:2")
133 I X'="" S LA7VAL=X_"^"_LA7VAL_"^SNM"
134 ;
135 S LA7OBX(8)=$$OBX8^LA7VOBX("A")
136 ;
137 ; Setup DoD special coding system
138 I LA7NVAF=1,$P(LA7CODE,"!",2) S LA7ALTCS="99VA64MO"
139 ;
140 ; Set flag to save sub-id for parent-child relationship
141 S LA7SAVID=1
142 Q
143 ;
144 ;
145MIC ; Organism's susceptibilities
146 ;
147 N LA7IENS,LA7SUB
148 ;
149 ; Bact or TB organism
150 S LA7SUB=$S($P(LRSB,",")=12:3,1:12)
151 ;
152 ;S LA7X=$O(^LAB(62.06,"AD",LRIDT(3),0)) Q:'LA7X
153 S LA7OBX(2)=$$OBX2^LA7VOBX(62.06,.01)
154 ;
155 S LA7X=$G(^LR(LRDFN,"MI",LRIDT,LA7SUB,LRIDT(2),LRIDT(3)))
156 S LA7VAL=$P(LA7X,"^")
157 I LA7VAL'="" D
158 . I "SIR"[$E(LA7VAL) S LA7OBX(8)=$$OBX8^LA7VOBX($E(LA7VAL)) Q
159 . I "SIR"[$E($P(LA7X,"^",2)) S LA7OBX(8)=$$OBX8^LA7VOBX($E($P(LA7X,"^",2))) Q
160 ;
161 ; Determine access screen for this susceptibility
162 I $P(LA7X,"^",3)="" S $P(LA7X,"^",3)="A"
163 S LA7OBX(13)=$$OBX13^LA7VOBX($P(LA7X,"^",3),"MIS",LA7FS,LA7ECH)
164 ;
165 ; Setup DoD special coding system
166 I LA7NVAF=1,$P(LA7CODE,"!",2) S LA7ALTCS="99VA64MS"
167 ;
168 Q
169 ;
170 ;
171GEN ; Fields common to all MI OBX segments.
172 ;
173 ; Initialize OBX segment
174 S LA7OBX(0)="OBX"
175 S LA7OBX(1)=$$OBX1^LA7VOBX(.LA7OBXSN)
176 ;
177 S LA7OBX(3)=$$OBX3^LA7VOBX($P(LA7CODE,"!",2),$P(LA7CODE,"!",3),LA7ALT,LA7FS,LA7ECH)
178 ;
179 ; Change normal coding system for DoD special
180 I LA7NVAF=1,LA7ALTCS'="" D
181 . F I=3,6 I $P(LA7OBX(3),$E(LA7ECH,1),I)="99VA64" S $P(LA7OBX(3),$E(LA7ECH,1),I)=LA7ALTCS Q
182 ;
183 ; Test value
184 S LA7OBX(5)=$$OBX5^LA7VOBX(LA7VAL,LA7OBX(2),LA7FS,LA7ECH)
185 ;
186 ; Set sub-id and save for constructing parents
187 I LA7ID'="" D
188 . S LA7OBX(4)=$$OBX4^LA7VOBX(LA7ID,LA7FS,LA7ECH)
189 . I LA7SAVID F I=1:1:3 S LA7ID(LA7ID,I)=LA7OBX(I+2)
190 ;
191 ; Order result status - "P"artial, "F"inal , "A"mended results
192 ; If no status from individual components then use status from zeroth node.
193 ; If no release date then pending else final
194 ; If amended, overrides all other status
195 I LA7ORS="" S LA7ORS=$S('$P(LA76305(0),"^",3):"P",1:"F")
196 I $P(LA76305(0),"^",9) S LA7ORS="A"
197 S LA7OBX(11)=$$OBX11^LA7VOBX(LA7ORS)
198 ;
199 S LA7DIV=""
200 I $$DIV4^XUSER(.LA7DIV,$P(LA76305(0),"^",4)) S LA7DIV=$O(LA7DIV(0))
201 ;
202 ; Observation date/time - collection date/time per HL7 standard
203 I $P(LA76305(0),"^") S LA7OBX(14)=$$OBX14^LA7VOBX($P(LA76305(0),"^"))
204 ;
205 ; Facility that performed the testing
206 S LA7OBX(15)=$$OBX15^LA7VOBX(LA7DIV,LA7FS,LA7ECH)
207 ;
208 ; Person that verified the test
209 I $P(LA76305(0),"^",4) S LA7VERP=$P(LA76305(0),"^",4)
210 I LA7VERP S LA7OBX(16)=$$OBX16^LA7VOBX(LA7VERP,LA7DIV,LA7FS,LA7ECH)
211 ;
212 D BUILDSEG^LA7VHLU(.LA7OBX,.LA7ARRAY,LA7FS)
213 ;
214 Q
Note: See TracBrowser for help on using the repository browser.