source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORHL09.m@ 1203

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

initial load of FOIAVistA 6/30/08 version
File size: 7.8 KB
Line 
1RORHL09 ;HOIFO/BH - HL7 OUTPATIENT DATA: PV1,OBR,OBX ; 3/13/06 9:24am
2 ;;1.5;CLINICAL CASE REGISTRIES;**1,5**;Feb 17, 2006;Build 10
3 ;
4 ; 11/29/2007 BAY/KAM ROR*1.5*5 Rem Call 218601 Correct Outpatient
5 ; CPTs not transmitting to the AAC
6 ;
7 ; This routine uses the following IAs:
8 ;
9 ; #93 Get stop code from the file #44 (controlled)
10 ; #1889 Use of the ENCEVENT^PXKENC API
11 ; #1995 $$CODEC^ICPTCOD (supported)
12 ; #2309 Read access to the 'AA' x-ref in VISIT file (#9000010)
13 ; #3990 $$CODEC^ICDCODE (supported)
14 ; #10060 Read access to the file #200 (supported)
15 ; #2438 Access to the file #40.8 (field #1) (controlled)
16 ;
17 Q
18 ;
19 ;***** PROCESSES DIAGNOSIS CODES
20DIAGS() ;
21 N DIAG,IEN,K5,OID,REC,TMP
22 S OID="OICD9"_RORCS_"Diagnosis"_RORCS_"VA080"
23 S K5=""
24 F S K5=$O(^TMP("PXKENC",$J,RORIEN,"POV",K5)) Q:K5="" D
25 . S REC=^TMP("PXKENC",$J,RORIEN,"POV",K5,0)
26 . S IEN=+$P(REC,U) Q:IEN'>0
27 . ;---
28 . S DIAG=$$CODEC^ICDCODE(IEN)
29 . D:DIAG'<0 SETOBX(OID,DIAG)
30 Q 0
31 ;
32 ;***** OUTPATIENT DATA SEGMENT BUILDER
33 ;
34 ; RORDFN DFN of Patient Record in File #2
35 ;
36 ; .DXDTS Reference to a local variable where the
37 ; data extraction time frames are stored.
38 ;
39 ; RORTY Set to either "PV1" or "OBR"
40 ;
41 ; The ^TMP("PXKENC",$J) and ^TMP("RORHL08",$J) global nodes are
42 ; used by this function.
43 ;
44 ; Return Values:
45 ; <0 Error Code
46 ; 0 Ok
47 ; >0 Non-fatal error(s)
48 ;
49EN1(RORDFN,DXDTS,RORTY) ;
50 N ERRCNT,PIEN,PV1CNT,RC
51 S (ERRCNT,RC)=0
52 ;
53 ;--- PV1 Segments
54 I RORTY="PV1" K ^TMP("PXKENC",$J),^TMP("RORHL09",$J) D
55 . N IDX,INVDT,ROREND
56 . S (IDX,PV1CNT)=0
57 . F S IDX=$O(DXDTS(2,IDX)) Q:IDX'>0 D Q:RC<0
58 . . S INVDT=9999999-$$FMADD^XLFDT($P(DXDTS(2,IDX),U)\1,-1)
59 . . S ROREND=9999999-$P(DXDTS(2,IDX),U,2)
60 . . F S INVDT=$O(^AUPNVSIT("AA",RORDFN,INVDT),-1) Q:'INVDT!(INVDT'>ROREND) D
61 . . . S PIEN=""
62 . . . F S PIEN=$O(^AUPNVSIT("AA",RORDFN,INVDT,PIEN),-1) Q:'PIEN D
63 . . . . S TMP=$$PV1(PIEN,RORDFN)
64 . . . . I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
65 . . . . ;--- Reference for the corresponding OBR segment
66 . . . . S:TMP'="S" PV1CNT=PV1CNT+1,^TMP("RORHL09",$J,PV1CNT)=PIEN
67 ;
68 ;--- OBR and OBX Segments
69 I RORTY="OBR" D K ^TMP("PXKENC",$J),^TMP("RORHL09",$J)
70 . S PV1CNT=0
71 . F S PV1CNT=$O(^TMP("RORHL09",$J,PV1CNT)) Q:PV1CNT'>0 D
72 . . S PIEN=+$G(^TMP("RORHL09",$J,PV1CNT)) Q:PIEN'>0
73 . . ;---
74 . . S TMP=$$OBR(PIEN,RORDFN)
75 . . I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
76 . . ;---
77 . . S TMP=$$OBX(PIEN,RORDFN)
78 . . I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
79 ;
80 ;--- Check for errors
81 Q $S(RC<0:RC,1:ERRCNT)
82 ;
83 ;***** OBR SEGMENT BUILDER (OUTPATIENT)
84 ;
85 ; RORIEN IEN of file #9000010
86 ; RORDFN DFN of Patient Record in File #2
87 ;
88 ; Return Values:
89 ; <0 Error Code
90 ; 0 Ok
91 ; >0 Non-fatal error(s)
92 ;
93OBR(RORIEN,RORDFN) ;
94 N CS,ERRCNT,RC,RORSEG,STN,TMP,VST0
95 S (ERRCNT,RC)=0
96 D ECH^RORHL7(.CS)
97 ;
98 S VST0=$G(^TMP("PXKENC",$J,RORIEN,"VST",RORIEN,0))
99 ;
100 ;--- Initialize the segment
101 S RORSEG(0)="OBR"
102 ;
103 ;--- OBR-3 - Order Number (IEN in the VISIT file #9000010)
104 S RORSEG(3)=RORIEN
105 ;
106 ;--- OBR-4 - Universal Service ID
107 S RORSEG(4)="OP"_CS_"Outpatient"_CS_"C4"
108 ;
109 ;--- OBR-7 - Observation Date/Time (Visit Date/Time) *KEY*
110 S TMP=$$FMTHL7^XLFDT($P(VST0,U))
111 Q:TMP'>0 $$ERROR^RORERR(-100,,,,"No visit date","ENCEVENT^PXKENC")
112 S RORSEG(7)=TMP
113 ;
114 ;--- OBR-24 - Diagnostic Service ID
115 S RORSEG(24)="PHY"
116 ;
117 ;--- OBR-44 - Division
118 S RORSEG(44)=$$SITE^RORUTL03(CS)
119 S TMP=+$P(VST0,U,6) ; LOC. OF ENCOUNTER (.06)
120 I TMP>0 D
121 . S TMP=$$NS^XUAF4(TMP),STN=$P(TMP,U,2)
122 . S:STN'="" RORSEG(44)=STN_CS_$P(TMP,U)_CS_"99VA4"
123 ;
124 ;--- Store the segment
125 D ADDSEG^RORHL7(.RORSEG)
126 Q ERRCNT
127 ;
128 ;***** OBX SEGMENT BUILDER (OUTPATIENT)
129 ;
130 ; RORIEN IEN of file #9000010
131 ; RORDFN DFN of Patient Record in File #2
132 ;
133 ; Return Values:
134 ; <0 Error Code
135 ; 0 Ok
136 ; >0 Non-fatal error(s)
137 ;
138OBX(RORIEN,RORDFN) ;
139 N ERRCNT,RC,RORCS,RORLST,RORMSG,RORSEG,TMP
140 S (ERRCNT,RC)=0
141 D ECH^RORHL7(.RORCS)
142 ;
143 ;--- Procedures
144 I $D(^TMP("PXKENC",$J,RORIEN,"CPT"))>1 D Q:RC<0 RC
145 . S RC=$$PROCS() S:RC ERRCNT=ERRCNT+1
146 ;--- Diagnosis codes
147 I $D(^TMP("PXKENC",$J,RORIEN,"POV"))>1 D Q:RC<0 RC
148 . S RC=$$DIAGS() S:RC ERRCNT=ERRCNT+1
149 ;
150 Q ERRCNT
151 ;
152 ;***** PROCESSES PROCEDURES
153PROCS() ;
154 N CLASS,ERRCNT,IEN,K5,OID,PROC,PRV,REC,RORMSG,TMP
155 S ERRCNT=0
156 S OID="OCPT"_RORCS_"Procedures"_RORCS_"VA080"
157 S K5=""
158 F S K5=$O(^TMP("PXKENC",$J,RORIEN,"CPT",K5)) Q:K5="" D
159 . S REC=$G(^TMP("PXKENC",$J,RORIEN,"CPT",K5,0))
160 . S IEN=+$P(REC,U) Q:IEN'>0
161 . ;---
162 . S PROC=$$CODEC^ICPTCOD(IEN)
163 . Q:PROC<0
164 . ;---
165 . S PRV=+$P($G(^TMP("PXKENC",$J,RORIEN,"CPT",K5,12)),U,4)
166 . ;12/06/2007 BAY/KAM REM CALL 218601 Modified next 8 lines
167 . ;---
168 . I PRV>0 D
169 .. S $P(PRV,RORCS,13)=$$GET1^DIQ(200,PRV_",",53.5,"E",,"RORMSG")
170 .. I $G(DIERR) D S ERRCNT=ERRCNT+1
171 ... D DBS^RORERR("RORMSG",-99,,RORDFN,200,+PRV_",")
172 . E S PRV=""
173 . ;----------> End of changes for 218601
174 . ;---
175 . D SETOBX(OID,PROC,PRV)
176 Q ERRCNT
177 ;
178 ;***** PV1 SEGMENT BUILDER (OUTPATIENT)
179 ;
180 ; RORIEN IEN in the file #9000010
181 ; RORDFN DFN of Patient Record in File #2
182 ;
183 ; Return Values:
184 ; <0 Error Code
185 ; 0 Ok
186 ; "S" No visit data
187 ; >0 Non-fatal error(s)
188 ;
189PV1(RORIEN,RORDFN) ;
190 N BUF,CLASS,CS,ERRCNT,IENS,KK4,RC,REC,REP,RORCLIN,RORMSG,PRV,TMP,TMP1,VST0
191 S (ERRCNT,RC)=0
192 D ECH^RORHL7(.CS,,.REP)
193 ;
194 ;--- Get Visit Data
195 D ENCEVENT^PXKENC(RORIEN,1)
196 Q:$D(^TMP("PXKENC",$J,RORIEN))<10 "S"
197 S VST0=$G(^TMP("PXKENC",$J,RORIEN,"VST",RORIEN,0))
198 ;
199 ;--- Do not send visits with the following service categories: Daily
200 ;--- Hospitalization (D), Ancillary (X), Chart (C), Not Found (N),
201 ; (E), Event Historical, Hospitalization (H).
202 Q:"HEDXNC"[$P(VST0,U,7) "S"
203 ;
204 ;--- Initialize the segment
205 S RORSEG(0)="PV1"
206 ;
207 ;--- PV1-2 - Patient Class
208 S RORSEG(2)="O" ; O - Outpatient
209 ;
210 ;--- PV1-3 - Assigned Patient Location (Station Number and Stop Code)
211 S RORCLIN=+$P(VST0,U,22),BUF=""
212 I RORCLIN>0 D
213 . S IENS=RORCLIN_","
214 . S TMP=$$GET1^DIQ(44,IENS,3.5,"I") Q:TMP'>0
215 . S BUF=$$GET1^DIQ(40.8,TMP,1) Q:BUF="" ; Station Number
216 . S TMP=$$STOPCODE^RORUTL18(+RORCLIN)
217 . S $P(BUF,CS,6)=$S(TMP>0:TMP,1:"") ; Stop Code
218 Q:$P(BUF,CS,6)="" "S" ; Stop Code is required
219 S RORSEG(3)=BUF
220 ;
221 ; PV1-4 - Admission Type
222 S TMP=$P($G(^TMP("PXKENC",$J,RORIEN,"VST",RORIEN,150)),U,3)
223 S RORSEG(4)=TMP
224 ;
225 ;--- PV1-7 - Attending Physician (User IEN and Provider Class Name)
226 S (KK4,BUF)=""
227 F S KK4=$O(^TMP("PXKENC",$J,RORIEN,"PRV",KK4)) Q:KK4="" D
228 . S REC=$G(^TMP("PXKENC",$J,RORIEN,"PRV",KK4,0))
229 . S PRV=+$P(REC,U) Q:(PRV'>0)!($P(REC,U,4)'="P")
230 . S $P(PRV,CS,13)=$$GET1^DIQ(200,PRV_",",53.5,"E",,"RORMSG")
231 . I $G(DIERR) D S ERRCNT=ERRCNT+1
232 . . D DBS^RORERR("RORMSG",-99,,RORDFN,200,PRV_",")
233 . S BUF=BUF_REP_PRV
234 S RORSEG(7)=$P(BUF,REP,2,999)
235 ;
236 ;--- PV1-19 - Visit Number (IEN in the VISIT file #9000010) *KEY*
237 S RORSEG(19)=RORIEN
238 ;
239 ;--- PV1-44 - Admit Date/Time (Visit Date/Time) *KEY*
240 S TMP=$$FMTHL7^XLFDT($P(VST0,U))
241 I TMP'>0 D Q RC
242 . S RC=$$ERROR^RORERR(-100,,,,"No admission date","ENCEVENT^PXKENC")
243 S RORSEG(44)=TMP
244 ;
245 ;--- PV1-51 - Visit Indicator (Deleted Visit Indicator)
246 S TMP=$P(VST0,U,11)
247 S RORSEG(51)=$S(TMP'="":TMP,1:0)
248 ;
249 ;--- Store the segment
250 D ADDSEG^RORHL7(.RORSEG)
251 Q ERRCNT
252 ;
253 ;***** LOW-LEVEL SEGMENT BUILDER
254 ;
255 ; OBX3 Observation Identifier
256 ;
257 ; OBX5 Observation Value
258 ;
259 ; [OBX16] Procedure Provider and Provider Class Name
260 ;
261SETOBX(OBX3,OBX5,OBX16) ;
262 N RORSEG
263 S RORSEG(0)="OBX"
264 ;--- OBX-2 Value Type
265 S RORSEG(2)="FT"
266 ;--- OBX-3 Observation Identifier
267 S RORSEG(3)=OBX3
268 ;--- OBX-5 Observation Value
269 S RORSEG(5)=OBX5
270 ;--- OBX-11 Observation Result Status
271 S RORSEG(11)="F"
272 ;--- OBX-16 Responsible Observer (Procedure Provider)
273 S:$G(OBX16)'="" RORSEG(16)=OBX16
274 ;--- Store the segment
275 D ADDSEG^RORHL7(.RORSEG)
276 Q
Note: See TracBrowser for help on using the repository browser.