source: WorldVistAEHR/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORHL09.m@ 1800

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

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