source: FOIAVistA/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7VHLU5.m@ 649

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

initial load of FOIAVistA 6/30/08 version
File size: 6.9 KB
Line 
1LA7VHLU5 ;DALOI/JMC - HL7 segment builder utility ; 11-1-2000
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64**;Sep 27, 1994
3 ;
4 ;
5DEFCODE(LRSS,LRSB,LA7CODE,LA761) ; Determine default codes when data is not mapped
6 ;
7 ; Call with LRSS = file #63 subscript
8 ; LRSB = file #63 dataname/location
9 ; LA7CODE = current codes stored with data (order nlt!result nlt!loinc code!method suffix)
10 ; LA761 = specimen, pointer to file #61
11 ;
12 N I,LA7DFCDE,LA7MISS
13 ;
14 I LA7CODE="" S LA7CODE="!!!"
15 ;
16 ; Replace any missing codes with defaults
17 ; If no missing codes then return codes passed in.
18 S LA7MISS=""
19 F I=1:1:3 I $P(LA7CODE,"!",I)="" S $P(LA7MISS,"^",I)=I
20 ;
21 I LA7MISS'="" D
22 . I LRSS="CH" D CHSUB Q
23 . I LRSS="MI" D MISUB Q
24 . I LRSS="SP" D SPSUB Q
25 . I LRSS="CY" D CYSUB Q
26 . I LRSS="EM" D EMSUB Q
27 ;
28 Q LA7CODE
29 ;
30 ;
31CHSUB ; Determine codes for CH subscript.
32 ;
33 N LA760,LA7NLT,LA7X,LA7Y
34 ;
35 ; Find a file #60 test which uses this dataname. Since there can be
36 ; multiple tests check each until an order and result NLT code is found.
37 S LA760=0
38 F S LA760=$O(^LAB(60,"C",LRSS_";"_LRSB_";1",LA760)) Q:'LA760 D
39 . ; Default order NLT
40 . I $P(LA7MISS,"^") D
41 . . S LA7X=$$NLT^LRVER1(LA760)
42 . . I LA7X'="" S $P(LA7CODE,"!")=LA7X,$P(LA7MISS,"^")=""
43 . ; Default result NLT
44 . I $P(LA7MISS,"^",2) D
45 . . S LA7X=+$P($G(^LAB(60,LA760,64)),"^",2),LA7Y=""
46 . . I LA7X S LA7Y=$$GET1^DIQ(64,LA7X_",",1)
47 . . I LA7Y'="" S $P(LA7CODE,"!",2)=LA7Y,$P(LA7MISS,"^",2)=""
48 ;
49 ; If no result NLT code then use order NLT as default
50 I $P(LA7CODE,"!",2)="" S $P(LA7CODE,"!",2)=$P(LA7CODE,"!")
51 ;
52 ; If no order NLT code found on file #60 entries then use this default
53 I $P(LA7CODE,"!")="" S $P(LA7CODE,"!")="81323.0000"
54 ;
55 ; Default result LOINC code based on result NLT code
56 ; If none on NLT result code then try order NLT code
57 I $P(LA7MISS,"^",3) D
58 . S LA7NLT=$P(LA7CODE,"!",2),LA7X=""
59 . I LA7NLT'="" S LA7X=$$LNC^LRVER1(LA7NLT,$P(LA7CODE,"!",4),LA761)
60 . I LA7X S $P(LA7CODE,"!",3)=LA7X Q
61 . S LA7NLT=$P(LA7CODE,"!"),LA7X=""
62 . I LA7NLT'="" S LA7X=$$LNC^LRVER1(LA7NLT,$P(LA7CODE,"!",4),LA761)
63 . I LA7X S $P(LA7CODE,"!",3)=LA7X
64 ;
65 Q
66 ;
67 ;
68MISUB ; Determine codes for MI subscript
69 ;
70 ; Bacteriology report
71 I LRSB=11 S LA7DFCDE="87993.0000^^" D DEFAULT Q
72 ;
73 ; Gram stain
74 I LRSB=11.6 S LA7DFCDE="87993.0000^87754.0000^664" D DEFAULT Q
75 ;
76 ; Bacteriology organism
77 I LRSB=12 S LA7DFCDE="87993.0000^87570.0000^11475" D DEFAULT Q
78 ;
79 ; Bacteria colony count
80 I +LRSB=12,$P(LRSB,",",2)=1 S LA7DFCDE="^87719.0000^564" D DEFAULT Q
81 ;
82 ; Parasite report
83 I LRSB=14 S LA7DFCDE="87505.0000^^" D DEFAULT Q
84 ;
85 ; Parasite organism
86 I LRSB=16 S LA7DFCDE="87505.0000^87576.0000^17784" D DEFAULT Q
87 ;
88 ; Mycology report
89 I LRSB=18 S LA7DFCDE="87994.0000^^" D DEFAULT Q
90 ;
91 ; Fungal organism
92 I LRSB=20 S LA7DFCDE="87994.0000^87578.0000^580" D DEFAULT Q
93 ;
94 ; Fungal colony count
95 I +LRSB=20,$P(LRSB,",",2)=1 S LA7DFCDE="87994.0000^87723.0000^19101" D DEFAULT Q
96 ;
97 ; Mycobacterium report
98 I LRSB=22 S LA7DFCDE="87995.0000^^" D DEFAULT Q
99 ;
100 ; Acid Fast stain
101 I LRSB=24 S LA7DFCDE="87995.0000^87756.0000^11545" D DEFAULT Q
102 ;
103 ; Acid Fast stain quantity
104 I LRSB=25 S LA7DFCDE="87995.0000^87583.0000^11545" D DEFAULT Q
105 ;
106 ; Mycobacterium organism
107 I +LRSB=26,'$P(LRSB,",",2) S LA7DFCDE="87995.0000^87589.0000^543" D DEFAULT Q
108 ;
109 ; Bact or TB organism's susceptibilities
110 I $P(LRSB,",",2)>2,$P(LRSB,",",2)<2.999 D Q
111 . I +LRSB'=12,+LRSB'=26 Q
112 . S LA7X=$O(^LAB(62.06,"AD",$P(LRSB,",",2),0)) Q:'LA7X
113 . I $P(LA7MISS,"^",2) S $P(LA7CODE,"!",2)=$$GET1^DIQ(62.06,LA7X_",","64:1")
114 . I $P(LA7MISS,"^",3) S $P(LA7CODE,"!",3)=$$GET1^DIQ(62.06,LA7X_",","64:25")
115 ;
116 ; Virology report
117 I LRSB=33 S LA7DFCDE="87996.0000^^" D DEFAULT Q
118 ;
119 ; Viral agent
120 I $P(LRSB,",")=36 S LA7DFCDE="87996.0000^87590.0000^6584" D DEFAULT Q
121 ;
122 Q
123 ;
124 ;
125SPSUB ; Determine codes for SP subscript
126 ;
127 ; specimens
128 I LRSB=.012!(LRSB=10) S LA7DFCDE="88515.0000^88539.0000^22633" D DEFAULT Q
129 ;
130 ; brief clinical history
131 I LRSB=.013 S LA7DFCDE="88515.0000^88542.0000^22636" D DEFAULT Q
132 ;
133 ; preoperative diagnosis
134 I LRSB=.014 S LA7DFCDE="88515.0000^88544.0000^10219" D DEFAULT Q
135 ;
136 ; operative findings
137 I LRSB=.015 S LA7DFCDE="88515.0000^88546.0000^10215" D DEFAULT Q
138 ;
139 ; postoperative diagnosis
140 I LRSB=.016 S LA7DFCDE="88515.0000^88547.0000^10218" D DEFAULT Q
141 ;
142 ; gross description
143 I LRSB=1 S LA7DFCDE="88515.0000^88549.0000^22634" D DEFAULT Q
144 ;
145 ; microscopic description
146 I LRSB=1.1 S LA7DFCDE="88515.0000^88563.0000^22635" D DEFAULT Q
147 ;
148 ; frozen section
149 I LRSB=1.3 S LA7DFCDE="88515.0000^88569.0000^322635" D DEFAULT Q
150 ;
151 ; surgical path diagnosis
152 I LRSB=1.4 S LA7DFCDE="88515.0000^88571.0000^22637" D DEFAULT Q
153 ;
154 ; supplementary report
155 I LRSB=1.2!(LRSB="10,5") S LA7DFCDE="88515.0000^88589.0000^22639" D DEFAULT Q
156 ;
157 ; specimen weight
158 I LRSB="10,2" S LA7DFCDE="88515.0000^81233.0000^3154" D DEFAULT Q
159 ;
160 Q
161 ;
162 ;
163CYSUB ; Determine codes for CY subscript
164 ;
165 ; specimens
166 I LRSB=.012 S LA7DFCDE="88593.0000^88539.0000^22633" D DEFAULT Q
167 ;
168 ; brief clinical history
169 I LRSB=.013 S LA7DFCDE="88593.0000^88542.0000^22636" D DEFAULT Q
170 ;
171 ; preoperative diagnosis
172 I LRSB=.014 S LA7DFCDE="88593.0000^88544.0000^10219" D DEFAULT Q
173 ;
174 ; operative findings
175 I LRSB=.015 S LA7DFCDE="88593.0000^88542.0000^10215" D DEFAULT Q
176 ;
177 ; postoperative diagnosis
178 I LRSB=.016 S LA7DFCDE="88593.0000^88547.0000^10218" D DEFAULT Q
179 ;
180 ; gross description
181 I LRSB=1!(LRSB=20) S LA7DFCDE="88593.0000^88549.0000^22634" D DEFAULT Q
182 ;
183 ; microscopic examination
184 I LRSB=1.1 S LA7DFCDE="88593.0000^88563.0000^22635" D DEFAULT Q
185 ;
186 ; supplementary report
187 I LRSB=1.2 S LA7DFCDE="88593.0000^88589.0000^22639" D DEFAULT Q
188 ;
189 ; cytopatholgy diagnosis
190 I LRSB=1.4 S LA7DFCDE="88593.0000^88571.0000^22637" D DEFAULT Q
191 ;
192 Q
193 ;
194 ;
195EMSUB ; Determine codes for EM subscript
196 ;
197 ; specimens
198 I LRSB=.012 S LA7DFCDE="88597.0000^88057.0000^22633" D DEFAULT Q
199 ;
200 ; brief clinical history
201 I LRSB=.013 S LA7DFCDE="88597.0000^88542.0000^22636" D DEFAULT Q
202 ;
203 ; preoperative diagnosis
204 I LRSB=.014 S LA7DFCDE="88597.0000^88544.0000^10219" D DEFAULT Q
205 ;
206 ; operative findings
207 I LRSB=.015 S LA7DFCDE="88597.0000^88542.0000^10215" D DEFAULT Q
208 ;
209 ; postoperative diagnosis
210 I LRSB=.016 S LA7DFCDE="88597.0000^88547.0000^10218" D DEFAULT Q
211 ;
212 ; gross description
213 I LRSB=1!(LRSB=20) S LA7DFCDE="88597.0000^88549.0000^22634" D DEFAULT Q
214 ;
215 ; microscopic examination
216 I LRSB=1.1 S LA7DFCDE="88597.0000^88563.0000^22635" D DEFAULT Q
217 ;
218 ; supplementary report
219 I LRSB=1.2 S LA7DFCDE="88597.0000^88589.0000^22639" D DEFAULT Q
220 ;
221 ; em diagnosis
222 I LRSB=1.4 S LA7DFCDE="88597.0000^88571.0000^22637" D DEFAULT Q
223 ;
224 Q
225 ;
226 ;
227DEFAULT ; Resolve codes and set defaults as needed
228 ;
229 ; Expects LA7DFCDE=default order NLT^default result NLT^default LOINC code
230 ;
231 I $P(LA7MISS,"^") S $P(LA7CODE,"!")=$P(LA7DFCDE,"^")
232 I $P(LA7MISS,"^",2) S $P(LA7CODE,"!",2)=$P(LA7DFCDE,"^",2)
233 I $P(LA7MISS,"^",3) D
234 . S $P(LA7CODE,"!",3)=$$LNC^LRVER1($P(LA7CODE,"!",2),$P(LA7CODE,"!",4),LA761)
235 . I '$P(LA7CODE,"!",3) S $P(LA7CODE,"!",3)=$P(LA7DFCDE,"^",3)
236 Q
Note: See TracBrowser for help on using the repository browser.