source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORHL10.m@ 677

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

initial load of FOIAVistA 6/30/08 version
File size: 6.2 KB
Line 
1RORHL10 ;HOIFO/BH - HL7 SURGICAL PATHOLOGY DATA: OBR,OBX ; 3/13/06 9:24am
2 ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
3 ;
4 ; This routine uses the following IAs:
5 ;
6 ; #525 Read access to the multiple #63.08 (controlled)
7 ; #4343 $$SPATH^LA7UTL03 (controlled)
8 ;
9 Q
10 ;
11 ;***** SEARCHES FOR SURGICAL PATHOLOGY DATA
12 ;
13 ; RORDFN IEN of the patient in the PATIENT file (#2)
14 ;
15 ; .DXDTS Reference to a local variable where the
16 ; data extraction time frames are stored.
17 ;
18 ; [CDSMODE] Search the data by:
19 ; 0 completion/result date (default)
20 ; 1 specimen collection date
21 ;
22 ; Return Values:
23 ; <0 Error code
24 ; 0 Ok
25 ; >0 Non-fatal error(s)
26 ;
27EN1(RORDFN,DXDTS,CDSMODE) ;
28 N ERRCNT,IDX,LRDFN,RC,RORENDT,RORSTDT
29 S (ERRCNT,RC)=0
30 ;
31 S LRDFN=+$$LABREF^RORUTL18(RORDFN) Q:LRDFN'>0 0
32 ;
33 S IDX=0
34 F S IDX=$O(DXDTS(9,IDX)) Q:IDX'>0 D Q:RC<0
35 . S RORSTDT=$P(DXDTS(9,IDX),U),RORENDT=$P(DXDTS(9,IDX),U,2)
36 . ;---
37 . S RC=$S($G(CDSMODE):$$CD(),1:$$RAD())
38 . S:RC>0 ERRCNT=ERRCNT+RC
39 ;
40 Q $S(RC<0:RC,1:ERRCNT)
41 ;
42 ;***** SEARCHES BY SPECIMEN COLLECTION DATE
43CD() ;
44 N ENDT,ERRCNT,IDT,STDT
45 S ERRCNT=0
46 S STDT=9999999-RORSTDT
47 S ENDT=9999999-RORENDT
48 ;---
49 S IDT=$O(^LR(LRDFN,"SP",STDT))
50 F S IDT=$O(^LR(LRDFN,"SP",IDT),-1) Q:'IDT!(IDT'>ENDT) D
51 . S:$$OBROBX(IDT,LRDFN) ERRCNT=ERRCNT+1
52 Q ERRCNT
53 ;
54 ;***** SEARCHES BY COMPLETION (RESULT) DATE
55RAD() ;
56 N ERRCNT,IDT,RCDT
57 S ERRCNT=0
58 ;---
59 S IDT=0
60 F S IDT=$O(^LR(LRDFN,"SP",IDT)) Q:IDT'>0 D
61 . S RCDT=$P($G(^LR(LRDFN,"SP",IDT,0)),U,3)
62 . I RCDT'<RORSTDT,RCDT<RORENDT S:$$OBROBX(IDT,LRDFN) ERRCNT=ERRCNT+1
63 Q ERRCNT
64 ;
65 ;***** CREATES OBR AND OBX SEGMENTS
66OBROBX(RORIDT,LRDFN) ;
67 N ERRCNT,RC
68 S ERRCNT=0
69 ;---
70 S RC=$$OBR(RORIDT_","_LRDFN_",")
71 I RC S ERRCNT=ERRCNT+1 Q:RC<0 RC
72 ;---
73 S RC=$$OBX(LRDFN,RORIDT)
74 I RC S ERRCNT=ERRCNT+1 Q:RC<0 RC
75 ;---
76 Q ERRCNT
77 ;
78 ;***** OBR SEGMENT BUILDER
79 ;
80 ; RORIENS IENS of SP Entry
81 ;
82 ; Return Values:
83 ; <0 Error code
84 ; 0 Ok
85 ; >0 Non-fatal error(s)
86 ;
87OBR(RORIENS) ;
88 N CS,ERRCNT,FLDS,IEN,RC,RORMSG,ROROUT,RORSEG,TMP
89 S (ERRCNT,RC)=0
90 D ECH^RORHL7(.CS)
91 ;--- Check the parameters
92 S:$E(RORIENS,$L(RORIENS))'="," RORIENS=RORIENS_","
93 ;
94 ;--- Load the data (with a temporary fix for invalid
95 ;--- output transform of the .01 field - ROR*1*8)
96 D GETS^DIQ(63.08,RORIENS,".01","I","ROROUT","RORMSG")
97 I $G(DIERR) D S ERRCNT=ERRCNT+1
98 . D DBS^RORERR("RORMSG",-9,,,63.08,RORIENS)
99 D GETS^DIQ(63.08,RORIENS,".03;.06;.07;.08","IE","ROROUT","RORMSG")
100 I $G(DIERR) D S ERRCNT=ERRCNT+1
101 . D DBS^RORERR("RORMSG",-9,,,63.08,RORIENS)
102 ;
103 ;--- Initialize the segment
104 S RORSEG(0)="OBR"
105 ;
106 ;--- OBR-3 - Surgical Pathology Acc #
107 I $G(ROROUT(63.08,RORIENS,.06,"E"))="" D Q RC
108 . S RC=$$ERROR^RORERR(-95,,,,63.08,RORIENS,.06)
109 S RORSEG(3)=ROROUT(63.08,RORIENS,.06,"E")
110 ;
111 ;--- OBR-4 - SP CPT Code
112 S RORSEG(4)="88300"_CS_"LEVEL I - SURGICAL PAT"_CS_"C4"
113 ;
114 ;--- OBR-7 - Date/Time Specimen Taken
115 S TMP=$$FMTHL7^XLFDT($G(ROROUT(63.08,RORIENS,.01,"I")))
116 Q:TMP'>0 $$ERROR^RORERR(-95,,,,63.08,RORIENS,.01)
117 S RORSEG(7)=TMP
118 ;
119 ;--- OBR-8 - Date Report Completed
120 S TMP=$G(ROROUT(63.08,RORIENS,.03,"I"))
121 S RORSEG(8)=$$FM2HL^RORHL7(TMP)
122 ;
123 ;--- OBR-16 - Surgeon/Physican
124 S RORSEG(16)=$G(ROROUT(63.08,RORIENS,.07,"I"))
125 ;
126 ;--- OBR-24 - Service Section ID
127 S RORSEG(24)="SP"
128 ;
129 ; OBR-44 - Divsion
130 S TMP=$G(ROROUT(63.08,RORIENS,.08,"I"))
131 S IEN=$S(TMP'="":+$O(^SC("B",TMP,0)),1:0)
132 S RORSEG(44)=$$DIV44^RORHLUT1(IEN,CS)
133 ;
134 ;--- Store the segment
135 D ADDSEG^RORHL7(.RORSEG)
136 Q ERRCNT
137 ;
138 ;***** OBX SEGMENT BUILDER
139 ;
140 ; LRDFN Patient Lab DFN
141 ; RORIENS IENS of SP Entry
142 ;
143 ; Return Values:
144 ; <0 Error code
145 ; 0 Ok
146 ; >0 Non-fatal error(s)
147 ;
148OBX(LRDFN,RORIENS) ;
149 N CS,ERRCNT,RC,RORMSG,ROROUT,RORSEG,RORTMP,RPS,TMP
150 S (ERRCNT,RC)=0
151 D ECH^RORHL7(.CS,,.RPS)
152 S RORTMP=$$ALLOC^RORTMP()
153 ;---
154 I $$SPATH^LA7UTL03(LRDFN,RORIENS,RORTMP,"RORMSG") D
155 . D SPECIMEN
156 . D SETOBXWP($$SEGID("BCH","Brief clinical History",CS),"CHIS")
157 . D SETOBXWP($$SEGID("PDIAG","Preoperative Diagnosis",CS),"PREDX")
158 . D SETOBXWP($$SEGID("OF","Operative Findings",CS),"OPERDX")
159 . S TMP=$$SEGID("POPDIAG","Postoperative Diagnosis",CS)
160 . D SETOBXWP(TMP,"POSTDX")
161 . D SETOBXWP($$SEGID("GDESC","Gross Decription",CS),"GROSSD")
162 . D SETOBXWP($$SEGID("MDESC","Microscopic Description",CS),"MICROD")
163 . S TMP=$$SEGID("SPDIAG","Surgical Pathology Diagnosis",CS)
164 . D SETOBXWP(TMP,"SURGP")
165 . D ICD(RPS)
166 E D:$D(RORMSG)>1
167 . N I,INFO S TMP=""
168 . F I=1:1 S TMP=$O(RORMSG(TMP)) Q:TMP="" S INFO(I)=RORMSG(TMP)
169 . S RC=$$ERROR^RORERR(-56,,.INFO,,0,"$$SPATH^LA7UTL03")
170 ;---
171 D FREE^RORTMP(RORTMP)
172 Q $S(RC<0:RC,1:ERRCNT)
173 ;
174 ;***** MAKES SPECIMEN OBX
175SPECIMEN ;
176 N INDEX,RORSPEC,SPECID
177 S INDEX="",SPECID=$$SEGID("SPEC","Specimen",CS)
178 F S INDEX=$O(@RORTMP@("SPEC",INDEX)) Q:INDEX="" D
179 . S RORSPEC=$G(@RORTMP@("SPEC",INDEX))
180 . D:RORSPEC'="" SETOBX(SPECID,RORSPEC)
181 Q
182 ;
183 ;***** ICD-9
184ICD(RPS) ;
185 N CNT,ICDLST,INDEX,RORICD,TMP
186 S ICDID=$$SEGID("ICD9","ICD9",CS)
187 S (INDEX,RORICD)="",CNT=0
188 F S INDEX=$O(@RORTMP@("ICD9",INDEX)) Q:INDEX="" D
189 . S TMP=$G(@RORTMP@("ICD9",INDEX))
190 . S:TMP'="" CNT=CNT+1,$P(RORICD,RPS,CNT)=TMP
191 D:RORICD'="" SETOBX(ICDID,RORICD)
192 Q
193 ;
194 ;***** CONSTRUCTS SEGMENT IDENTIFIER
195SEGID(CODE,NAME,CS) ;
196 Q CODE_CS_NAME_CS_"VA080"
197 ;
198 ;***** CREATE AND STORE THE OBX SEGMENTS
199SETOBX(OBX3,OBX5) ;
200 N RORSEG
201 ;--- Initialize the segment
202 S RORSEG(0)="OBX"
203 ;--- OBX-2 - Value Type
204 S RORSEG(2)="FT"
205 ;--- OBX-3 - Observation Identifier
206 S RORSEG(3)=OBX3
207 ;--- OBX-5 - Observation Value
208 S RORSEG(5)=$$ESCAPE^RORHL7(OBX5)
209 ;--- OBX-11 - Observation Result Status
210 S RORSEG(11)="F"
211 ;--- Store the segment
212 D ADDSEG^RORHL7(.RORSEG)
213 Q
214 ;
215SETOBXWP(OBX3,SUBS) ;
216 N BR,CNT,I,I1,RORSEG,TMP
217 S BR=$E(HLECH,3)_".br"_$E(HLECH,3)
218 Q:$D(@RORTMP@(SUBS))<10
219 ;--- Initialize the segment
220 S RORSEG(0)="OBX"
221 ;--- OBX-2 - Value Type
222 S RORSEG(2)="FT"
223 ;--- OBX-3 - Observation Identifier
224 S RORSEG(3)=OBX3
225 ;--- OBX-5 - Observation Value
226 S I=$O(@RORTMP@(SUBS,"")),CNT=0
227 F Q:I="" S I1=$O(@RORTMP@(SUBS,I)) D S I=I1
228 . S TMP=$$ESCAPE^RORHL7(@RORTMP@(SUBS,I))
229 . S CNT=CNT+1,RORSEG(5,CNT)=$S(I1'="":TMP_BR,1:TMP)
230 ;--- OBX-11 - Observation Result Status
231 S RORSEG(11)="F"
232 ;--- Store the segment
233 D:$D(RORSEG(5)) ADDSEG^RORHL7(.RORSEG)
234 Q
Note: See TracBrowser for help on using the repository browser.