source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORHL121.m

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

initial load of FOIAVistA 6/30/08 version
File size: 7.5 KB
Line 
1RORHL121 ;HOIFO/BH - HL7 MICROBIOLOGY DATA: OBX ; 8/31/05 1:16pm
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 Q
5 ;
6FUNGUS ;***** Process Fungus/Yeast
7 N FYIEN,RORFYIEN,RORFYID,RORFYCM
8 ;
9 S RORFYID=$$SEGID("FUNG","Fungus-Yeast",CS)
10 S RORFYCM=$$SEGID("FUNGC","F-Y Comment",CS)
11 S RORFYIEN=""
12 F S RORFYIEN=$O(@RORREF@(9,RORFYIEN)) Q:'RORFYIEN D
13 . S TMP=$G(@RORREF@(9,RORFYIEN,0,.01,"E"))
14 . Q:TMP=""
15 . D SETOBX(RORFYID,,TMP,$G(@RORREF@(9,RORFYIEN,0,1,"I")))
16 . ;---
17 . S FYIEN=""
18 . F S FYIEN=$O(@RORREF@(9,RORFYIEN,1,FYIEN)) Q:FYIEN="" D
19 . . S TMP=$G(@RORREF@(9,RORFYIEN,1,FYIEN,0,.01,"E"))
20 . . D:TMP'="" SETOBX(RORFYCM,,TMP)
21 Q
22 ;
23BACSP ;***** Bacteriology Smear/Prep
24 ;
25 N RORBSPID,RORBSP
26 S RORBSPID=$$SEGID("BACT-SP","Bact Smear/Prep",CS)
27 ;
28 S RORBSP=""
29 F S RORBSP=$O(@RORREF@(25,RORBSP)) Q:'RORBSP D
30 . S TMP=$G(@RORREF@(25,RORBSP,0,.01,"E"))
31 . D:TMP'="" SETOBX(RORBSPID,,TMP)
32 Q
33 ;
34MYCO ;***** Mycobacterium
35 N RORMYD,RORMYD1,RORDF,RORDO,RORMYIEN,RORMYID,RORMYCM,MYIEN,RORMYF,RORMYO,TMP,TMP1
36 S RORMYID=$$SEGID("MYCO","Mycobacterium",CS)
37 S RORMYCM=$$SEGID("MYCOC","Myco Comment",CS)
38 S RORMYF=$$SEGID("MYCOAF","Myco Anti-F",CS)
39 S RORMYO=$$SEGID("MYCOAO","Myco Anti-O",CS)
40 ;
41 S RORMYIEN=""
42 F S RORMYIEN=$O(@RORREF@(12,RORMYIEN)) Q:'RORMYIEN D
43 . S TMP=$G(@RORREF@(12,RORMYIEN,0,.01,"E"))
44 . Q:TMP=""
45 . D SETOBX(RORMYID,,TMP,$G(@RORREF@(12,RORMYIEN,0,1,"I")))
46 . ;---
47 . S MYIEN=""
48 . F S MYIEN=$O(@RORREF@(12,RORMYIEN,1,MYIEN)) Q:MYIEN="" D
49 . . S TMP=$G(@RORREF@(12,RORMYIEN,1,MYIEN,0,.01,"E"))
50 . . D:TMP'="" SETOBX(RORMYCM,,TMP)
51 . ;
52 . S RORMYD=2
53 . F S RORMYD=$O(@RORREF@(12,RORMYIEN,0,RORMYD)) Q:'RORMYD!(RORMYD'<3) D
54 . . S TMP=$G(@RORREF@(12,RORMYIEN,0,RORMYD,"I")) Q:TMP?."^"
55 . . D SETOBX(RORMYF,$P(TMP,U),$P(TMP,U,2))
56 . ;
57 . S RORMYD1=4
58 . F S RORMYD1=$O(@RORREF@(12,RORMYIEN,0,RORMYD1)) Q:'RORMYD1!(RORMYD1'<56) D
59 . . S TMP=$G(@RORREF@(12,RORMYIEN,0,RORMYD1,"I")) Q:TMP?."^"
60 . . D SETOBX(RORMYO,$P(TMP,U),$P(TMP,U,2))
61 Q
62 ;
63MYCOSP ;***** Mycology Smear Prep
64 ;
65 N RORMSPID,RORMSPIN
66 S RORMSPID=$$SEGID("MYCO-SP","Mycology Smear/Prep",CS)
67 ;
68 S RORMSPIN=""
69 F S RORMSPIN=$O(@RORREF@(15,RORMSPIN)) Q:'RORMSPIN D
70 . S TMP=$G(@RORREF@(15,RORMSPIN,0,.01,"E"))
71 . D:TMP'="" SETOBX(RORMSPID,,TMP)
72 Q
73 ;
74 ;***** MICROBIOLOGY OBX SEGMENT(S) BUILDER
75 ;
76 ; RORREF Global reference for MI entry
77 ;
78 ; Return Values:
79 ; <0 Error code
80 ; 0 Ok
81 ; >0 Non-fatal error(s)
82 ;
83OBX(RORREF) ;
84 N CS,ERRCNT,RORTBST,IEN,RC,RORID,TMP
85 S (ERRCNT,RC)=0
86 D ECH^RORHL7(.CS)
87 ;
88 ;--- Process TB data if Final report
89 S RORTBST=$G(@RORREF@(0,23,"I"))
90 I RORTBST="F" D
91 . N RORTBDTE,RORTBAFS,RORTBQTY
92 . S RORID=$$SEGID("AFB-SP","TB Report",CS)
93 . S RORTBDTE=$$FM2HL^RORHL7($G(@RORREF@(0,22,"I")))
94 . S RORTBAFS=$G(@RORREF@(0,24,"I"))
95 . S RORTBQTY=$G(@RORREF@(0,25,"I"))
96 . D SETOBX(RORID,,RORTBST,RORTBQTY,RORTBAFS,,RORTBDTE)
97 ;
98 ;--- Get Bact RPT Remark Data
99 S RORID=$$SEGID("BACT","Bact",CS)
100 S IEN=""
101 F S IEN=$O(@RORREF@(4,IEN)) Q:'IEN D
102 . S TMP=$G(@RORREF@(4,IEN,0,.01,"E"))
103 . D:TMP'="" SETOBX(RORID,,TMP)
104 ;
105 ;--- Get Gram Stain Data
106 S RORID=$$SEGID("GRAM","Gram Stain",CS)
107 S IEN=""
108 F S IEN=$O(@RORREF@(2,IEN)) Q:'IEN D
109 . S TMP=$G(@RORREF@(2,IEN,0,.01,"E"))
110 . D:TMP'="" SETOBX(RORID,,TMP)
111 ;
112 D ORGDATA ; Organism Data
113 D PARDATA ; Parasite Data
114 D FUNGUS ; Fungus/Yeast Data
115 D MYCO ; Mycobacterium Data
116 D VIRUS ; Virus Data
117 D PARASP ; Parasitology Smear/Prep
118 D BACSP ; Bacteriology Smear/Prep
119 D MYCOSP ; Mycology Smear Prep
120 D VIRORPT ; Virology RPT Remark
121 ;
122 ;--- Parasite Remark
123 S RORID=$$SEGID("PARP","Parasite Remark",CS)
124 S IEN=""
125 F S IEN=$O(@RORREF@(7,IEN)) Q:IEN="" D
126 . S TMP=$G(@RORREF@(7,IEN,0,.01,"E"))
127 . D:TMP'="" SETOBX(RORID,,TMP)
128 ;
129 ;--- Specimen Comments
130 S TMP=$G(@RORREF@(0,.99,"E"))
131 I TMP'="" D D SETOBX(RORID,,TMP)
132 . S RORID=$$SEGID("COMP","Specimen Comment",CS)
133 ;
134 Q $S(RC<0:RC,1:ERRCNT)
135 ;
136 ;***** PROCESSES ORGANISM DATA
137ORGDATA ;
138 N IEN,RORANTID,RORCMID,RORID,RORMBC,RORMIC,RORORIEN,RORAINX,RORAINX1,RORANTIF,RORANTIO,TMP,TMP1
139 S RORID=$$SEGID("ORG","Organism",CS)
140 S RORCMID=$$SEGID("ORGC","Org Comment",CS)
141 S RORANTID=$$SEGID("ORGA","Org Antibiotic",CS)
142 S RORANTIF=$$SEGID("ORGAF","Org Antibiotic-F",CS)
143 S RORANTIO=$$SEGID("ORGAO","Org Antibiotic-O",CS)
144 ;---
145 S RORORIEN=""
146 F S RORORIEN=$O(@RORREF@(3,RORORIEN)) Q:'RORORIEN D
147 . S TMP=$G(@RORREF@(3,RORORIEN,0,.01,"E"))
148 . Q:TMP=""
149 . D SETOBX(RORID,,TMP,$G(@RORREF@(3,RORORIEN,0,1,"I")))
150 . ;---
151 . S RORAINX=2
152 . F S RORAINX=$O(@RORREF@(3,RORORIEN,0,RORAINX)) Q:'RORAINX!(RORAINX'<3) D
153 . . S TMP=$G(@RORREF@(3,RORORIEN,0,RORAINX,"I")) Q:TMP?."^"
154 . . D SETOBX(RORANTIF,$P(TMP,U),$P(TMP,U,2))
155 . ;---
156 . S RORAINX1=10
157 . F S RORAINX1=$O(@RORREF@(3,RORORIEN,0,RORAINX1)) Q:'RORAINX1!(RORAINX1'<160) D
158 . . S TMP=$G(@RORREF@(3,RORORIEN,0,RORAINX1,"I")) Q:TMP?."^"
159 . . D SETOBX(RORANTIO,$P(TMP,U),$P(TMP,U,2))
160 . ;---
161 . S IEN=""
162 . F S IEN=$O(@RORREF@(3,RORORIEN,1,IEN)) Q:IEN="" D
163 . . S TMP=$G(@RORREF@(3,RORORIEN,1,IEN,0,.01,"E"))
164 . . D:TMP'="" SETOBX(RORCMID,,TMP)
165 . ;---
166 . S IEN=""
167 . F S IEN=$O(@RORREF@(3,RORORIEN,3,IEN)) Q:IEN="" D
168 . . S TMP=$G(@RORREF@(3,RORORIEN,3,IEN,0,.01,"E"))
169 . . Q:TMP=""
170 . . S RORMIC=$G(@RORREF@(3,RORORIEN,3,IEN,0,1,"E"))
171 . . S RORMBC=$G(@RORREF@(3,RORORIEN,3,IEN,0,2,"E"))
172 . . D SETOBX(RORANTID,,TMP,,RORMIC,RORMBC)
173 Q
174 ;
175PARASP ;***** Parasitology Smear/Prep
176 ;
177 N RORPSPID,RORPSP
178 S RORPSPID=$$SEGID("PARA-SP","Para Smear/Prep",CS)
179 ;
180 S RORPSP=""
181 F S RORPSP=$O(@RORREF@(24,RORPSP)) Q:'RORPSP D
182 . S TMP=$G(@RORREF@(24,RORPSP,0,.01,"E"))
183 . D:TMP'="" SETOBX(RORPSPID,,TMP)
184 Q
185 ;
186 ;***** PROCESSES PARASITE DATA
187PARDATA ;
188 N IEN,RORPCMID,RORPSID,RORPSIEN,RORSTID,RORSTIEN,RORSTQAN,TMP
189 S RORPSID=$$SEGID("PAR","Parasite",CS)
190 S RORSTID=$$SEGID("PARQ","Stage",CS)
191 S RORPCMID=$$SEGID("PARC","Comment",CS)
192 ;---
193 S RORPSIEN=""
194 F S RORPSIEN=$O(@RORREF@(6,RORPSIEN)) Q:RORPSIEN="" D
195 . S TMP=$G(@RORREF@(6,RORPSIEN,"0",".01","E"))
196 . Q:TMP=""
197 . D SETOBX(RORPSID,,TMP)
198 . ;---
199 . S RORSTIEN=""
200 . F S RORSTIEN=$O(@RORREF@(6,RORPSIEN,1,RORSTIEN)) Q:RORSTIEN="" D
201 . . S TMP=$G(@RORREF@(6,RORPSIEN,1,RORSTIEN,0,.01,"I"))
202 . . Q:TMP=""
203 . . S RORSTQAN=$G(@RORREF@(6,RORPSIEN,1,RORSTIEN,0,"1","E"))
204 . . D SETOBX(RORSTID,,TMP,RORSTQAN)
205 . . ;---
206 . . S IEN=""
207 . . F S IEN=$O(@RORREF@(6,RORPSIEN,1,RORSTIEN,1,IEN)) Q:IEN="" D
208 . . . S TMP=$G(@RORREF@(6,RORPSIEN,1,RORSTIEN,1,IEN,0,.01,"E"))
209 . . . D:TMP'="" SETOBX(RORPCMID,,TMP)
210 Q
211 ;
212 ;***** CREATES SEGMENT IDENTIFIER
213SEGID(PONE,PTWO,CS) ;
214 Q PONE_CS_PTWO_CS_"VA080"
215 ;
216 ;***** CREATES AND STORES THE OBX SEGMENT
217SETOBX(OBX3,OBX4,OBX5,OBX6,OBX7,OBX13,OBX14) ;
218 N RORSEG
219 ;--- Initialize the segment
220 S RORSEG(0)="OBX"
221 ;--- OBX-2
222 S RORSEG(2)="FT"
223 ;--- OBX-3
224 S RORSEG(3)=OBX3
225 ;--- OBX-4, OBX-5, OBX-6, and OBX-7
226 S:$G(OBX4)'="" RORSEG(4)=$$ESCAPE^RORHL7(OBX4)
227 S:$G(OBX5)'="" RORSEG(5)=$$ESCAPE^RORHL7(OBX5)
228 S:$G(OBX6)'="" RORSEG(6)=$$ESCAPE^RORHL7(OBX6)
229 S:$G(OBX7)'="" RORSEG(7)=$$ESCAPE^RORHL7(OBX7)
230 ;--- OBX-11
231 S RORSEG(11)="F"
232 ;--- OBX-13 and OBX-14
233 S:$G(OBX13)'="" RORSEG(13)=$$ESCAPE^RORHL7(OBX13)
234 S:$G(OBX14)'="" RORSEG(14)=OBX14
235 ;--- Store the segment
236 D ADDSEG^RORHL7(.RORSEG)
237 Q
238 ;
239VIRORPT ;***** Virology RPT Remark
240 N RORVRID,RORVRIEN
241 S RORVRID=$$SEGID("VIRUSR","Virology RPT",CS)
242 ;
243 S RORVRIEN=""
244 F S RORVRIEN=$O(@RORREF@(18,RORVRIEN)) Q:'RORVRIEN D
245 . S TMP=$G(@RORREF@(18,RORVRIEN,0,.01,"E"))
246 . D:TMP'="" SETOBX(RORVRID,,TMP)
247 Q
248 ;
249VIRUS ;***** Virus
250 ;
251 N RORVIRID,RORVIIEN
252 S RORVIRID=$$SEGID("VIRUS","Virus",CS)
253 ;
254 S RORVIIEN=""
255 F S RORVIIEN=$O(@RORREF@(17,RORVIIEN)) Q:'RORVIIEN D
256 . S TMP=$G(@RORREF@(17,RORVIIEN,0,.01,"E"))
257 . D:TMP'="" SETOBX(RORVIRID,,TMP)
258 Q
Note: See TracBrowser for help on using the repository browser.