source: FOIAVistA/tag/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7VORU1.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 5.5 KB
Line 
1LA7VORU1 ;DALOI/JMC - Builder of HL7 Lab Results Microbiology OBR/OBX/NTE ; 05/26/00
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64**;Sep 27, 1994
3 Q
4 ;
5 ;
6MI ; Build segments for "MI" subscript
7 ;
8 N LA7ID,LA7IDT,LA7IENS,LA7NLT,LRDFN,LRIDT,LRSB,LRSS
9 ;
10 S LRDFN=LA("LRDFN"),LRSS=LA("SUB"),(LA7IENS,LRIDT)=LA("LRIDT")
11 ;
12 ; Bacteriology Report
13 I $D(^LR(LRDFN,LRSS,LRIDT,1)) D
14 . S LRSB=11,LA7NLT="87993.0000"
15 . D OBR^LA7VORU
16 . D NTE^LA7VORU
17 . F LRSB=1,1.5,11 D RPTNTE
18 . N LRSB
19 . S LA7OBXSN=0
20 . ; Report gram stain
21 . I $D(^LR(LRDFN,LRSS,LRIDT,2)) D GS
22 . ; Check for organism id
23 . I '$D(^LR(LRDFN,LRSS,LRIDT,3)) Q
24 . S LRSB=12
25 . D ORG
26 . D MIC
27 ;
28 ; Parasite report
29 I $D(^LR(LRDFN,LRSS,LRIDT,5)) D
30 . S LRSB=14,LA7NLT="87505.0000"
31 . D OBR^LA7VORU
32 . D NTE^LA7VORU
33 . F LRSB=16.5,16.4,14 D RPTNTE
34 . ; Check for organism id
35 . I '$D(^LR(LRDFN,LRSS,LRIDT,6)) Q
36 . N LRSB
37 . S LA7OBXSN=0,LA7IDT=LRIDT,LRSB=16
38 . D ORG
39 ;
40 ; Mycology report
41 I $D(^LR(LRDFN,LRSS,LRIDT,8)) D
42 . S LRSB=18,LA7NLT="87994.0000"
43 . D OBR^LA7VORU
44 . D NTE^LA7VORU
45 . F LRSB=20.5,20.4,18 D RPTNTE
46 . ; Check for organism id
47 . I '$D(^LR(LRDFN,LRSS,LRIDT,9)) Q
48 . N LRSB
49 . S LA7OBXSN=0,LA7IDT=LRIDT,LRSB=20
50 . D ORG
51 ;
52 ; Mycobacterium report
53 I $D(^LR(LRDFN,LRSS,LRIDT,11)) D
54 . S LRSB=22,LA7NLT="87995.0000"
55 . D OBR^LA7VORU
56 . D NTE^LA7VORU
57 . F LRSB=26.5,26.4,22 D RPTNTE
58 . N LRSB
59 . S LA7OBXSN=0,LA7IDT=LRIDT
60 . ; Report acid fast stain
61 . I $L($P(^LR(LRDFN,LRSS,LRIDT,11),"^",3)) D
62 . . S LRSB=24 D OBX
63 . . S LRSB=25 D OBX
64 . ; Check for organism id
65 . I '$D(^LR(LRDFN,LRSS,LRIDT,12)) Q
66 . S LRSB=26
67 . D ORG
68 . D MIC
69 ;
70 ; Virology report
71 I $D(^LR(LRDFN,LRSS,LRIDT,16)) D
72 . S LRSB=33,LA7NLT="87996.0000"
73 . D OBR^LA7VORU
74 . D NTE^LA7VORU
75 . F LRSB=36.5,36.4,33 D RPTNTE
76 . ; Check for virus id
77 . I '$D(^LR(LRDFN,LRSS,LRIDT,17)) Q
78 . N LRSB
79 . S LA7OBXSN=0,LA7IDT=LRIDT,LRSB=36
80 . D ORG
81 ;
82 Q
83 ;
84 ;
85GS ; Report Gram stain
86 ;
87 N LA7GS
88 ;
89 S LRSB=11.6,LA7GS=0
90 F S LA7GS=$O(^LR(LRDFN,LRSS,LRIDT,2,LA7GS)) Q:'LA7GS D
91 . S LA7IDT=LRIDT_","_LA7GS
92 . D OBX
93 Q
94 ;
95 ;
96RPTNTE ; Send report comments
97 ;
98 N LA7J,LA7ND,LA7SOC,LA7TXT
99 ;
100 ; Source of comment - handle special codes for other systems, i,e. DOD-CHCS
101 S LA7SOC=$S($G(LA7NVAF)=1:"AC",1:"L")
102 ;
103 ; Bacterial preliminary/report/tests remark
104 I LRSB=11 S LA7ND=4
105 I LRSB=1 S LA7ND=19
106 I LRSB=1.5 S LA7ND=26
107 ; Parasite preliminary/report/tests remark
108 I LRSB=14 S LA7ND=7
109 I LRSB=16.5 S LA7ND=21
110 I LRSB=16.4 S LA7ND=27
111 ; Fungal preliminary/report/tests remark
112 I LRSB=18 S LA7ND=10
113 I LRSB=20.5 S LA7ND=22
114 I LRSB=20.4 S LA7ND=28
115 ; Mycobacteria preliminary/report/tests remark
116 I LRSB=22 S LA7ND=13
117 I LRSB=26.5 S LA7ND=23
118 I LRSB=26.4 S LA7ND=29
119 ; Viral preliminary/report/tests remark
120 I LRSB=33 S LA7ND=18
121 I LRSB=36.5 S LA7ND=20
122 I LRSB=36.4 S LA7ND=30
123 ;
124 S LA7J=0
125 F S LA7J=$O(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7J)) Q:'LA7J D
126 . S LA7TXT=$G(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7J,0))
127 . D NTE
128 Q
129 ;
130 ;
131ORG ; Build OBR/OBX segments for MI subscript organism id
132 ;
133 N LA7ND,LA7ORG
134 ;
135 ; Bacterial organism
136 I LRSB=12 S LA7ND=3
137 ; Parasite organism
138 I LRSB=16 S LA7ND=6
139 ; Fungal organism
140 I LRSB=20 S LA7ND=9
141 ; Mycobacteria organism
142 I LRSB=26 S LA7ND=12
143 ; Viral agent
144 I LRSB=36 S LA7ND=17
145 ;
146 S LA7ORG=0
147 F S LA7ORG=$O(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG)) Q:'LA7ORG D
148 . S LA7IDT=LRIDT_","_LA7ORG_","
149 . D OBX
150 . I $L($P($G(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG,0)),"^",2)) D CC
151 . I LA7ND=17 Q
152 . D ORGNTE
153 Q
154 ;
155 ;
156CC ; Send colony count (quantity)
157 ;
158 N LRSB
159 ;
160 I LA7ND=3 S LRSB="12,1"
161 I LA7ND=9 S LRSB="20,1"
162 I LA7ND=12 S LRSB="26,1"
163 ;
164 D OBX
165 ;
166 Q
167 ;
168 ;
169ORGNTE ; Send comments on organisms.
170 ;
171 N LA7J,LA7SOC,LA7NTESN,LA7TXT
172 ;
173 ; Source of comment - handle special codes for other systems, i,e. DOD-CHCS
174 S LA7SOC=$S($G(LA7NVAF)=1:"RC",1:"L")
175 ;
176 S (LA7J,LA7NTESN)=0
177 F S LA7J=$O(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG,1,LA7J)) Q:'LA7J D
178 . S LA7TXT=$G(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG,1,LA7J,0))
179 . D NTE
180 Q
181 ;
182 ;
183MIC ; Build OBR/OBX segments for MI subscript susceptibilities(MIC)
184 ;
185 N LA7ORG,LA7ND,LA7NLT,LA7SB,LA7SB1,LA7SOC
186 ;
187 ; Source of comment - handle special codes for other systems, i,e. DOD-CHCS
188 S LA7SOC=$S($G(LA7NVAF)=1:"RC",1:"L")
189 ;
190 S (LA7NLT,LA7NLT(1))=""
191 I LRSB=12 S LA7ND=3,LA7NLT="87565.0000",LA7NLT(1)="87993.0000"
192 I LRSB=26 S LA7ND=12,LA7NLT="87899.0000",LA7NLT(1)="87525.0000"
193 ;
194 S LA7ORG=0,LA7SB=LRSB
195 F S LA7ORG=$O(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG)) Q:'LA7ORG D
196 . N LA7NTESN,LA7PARNT
197 . ; Check for susceptibiliites for this organism
198 . S X=$O(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG,2))
199 . I X<2!(X>2.99) Q
200 . S LA7PARNT=LA7SB_"-"_LA7ORG
201 . M LA7PARNT=LA7ID(LA7PARNT)
202 . D OBR^LA7VORU
203 . S LA7OBXSN=0,LA7SB1=2
204 . F S LA7SB1=$O(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7ORG,LA7SB1)) Q:'LA7SB1 D
205 . . N LRSB
206 . . S LA7IDT=LRIDT_","_LA7ORG_","_LA7SB1,LRSB=LA7SB_","_LA7SB1
207 . . D OBX
208 . . S X=$O(^LAB(62.06,"AD",LA7SB1,0)) Q:'X
209 . . S LA7TXT=$P($G(^LAB(62.06,X,0)),"^",3)
210 . . I LA7TXT'="" S LA7NTESN=0 D NTE
211 Q
212 ;
213 ;
214OBX ; Build OBX segments for MI subscript
215 ; Also called by AP^LA7VORU2 to build AP OBX segments.
216 ;
217 N LA7DATA
218 D OBX^LA7VOBX(LRDFN,LRSS,LA7IDT,LRSB,.LA7DATA,.LA7OBXSN,LA7FS,LA7ECH,LA7NVAF)
219 ;
220 ; If OBX failed to build then don't store
221 I '$D(LA7DATA) Q
222 ;
223 D FILESEG^LA7VHLU(GBL,.LA7DATA)
224 ;
225 ; Check for flag to only build meesage but do not file
226 I '$G(LA7NOMSG) D FILE6249^LA7VHLU(LA76249,.LA7DATA)
227 Q
228 ;
229 ;
230NTE ; Build NTE segment with comment
231 ;
232 N LA7NTE
233 ;
234 S LA7NTE(0)=$$NTE^LA7VHLU3(LA7TXT,$G(LA7SOC),LA7FS,LA7ECH,.LA7NTESN)
235 D FILESEG^LA7VHLU(GBL,.LA7NTE)
236 ;
237 ; Check for flag to only build meesage but do not file
238 I '$G(LA7NOMSG) D FILE6249^LA7VHLU(LA76249,.LA7NTE)
239 ;
240 Q
Note: See TracBrowser for help on using the repository browser.