source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORHL08.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.4 KB
Line 
1RORHL08 ;HOIFO/BH - HL7 INPATIENT DATA: PV1,OBR ; 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 ; #92 Read access to the PTF file (controlled)
7 ; #994 Read access to the PTF CLOSE OUT file (controlled)
8 ;
9 Q
10 ;
11 ;***** INPATIENT DATA SEGMENT BUILDER
12 ;
13 ; RORDFN DFN of Patient Record in File #2
14 ;
15 ; .DXDTS Reference to a local variable where the
16 ; data extraction time frames are stored.
17 ;
18 ; RORTY Set to either "PV1" or "OBR"
19 ;
20 ; The ^TMP("RORHL08",$J) global node is used by this function.
21 ;
22 ; Return Values:
23 ; <0 Error Code
24 ; 0 Ok
25 ; >0 Non-fatal error(s)
26 ;
27EN1(RORDFN,DXDTS,RORTY) ;
28 N ERRCNT,IENS,INIEN,PV1CNT,RC,RORMSG,TMP
29 S (ERRCNT,RC)=0
30 ;
31 ;--- PV1 Segments
32 I RORTY="PV1" K ^TMP("RORHL08",$J) D
33 . N DATE,ENDT,IDX,STDT,TYPE,XREF
34 . S XREF=$NA(^TMP("RORPTF",$J,"PDI",RORDFN))
35 . S (IDX,PV1CNT)=0
36 . F S IDX=$O(DXDTS(3,IDX)) Q:IDX'>0 D Q:RC<0
37 . . S STDT=$P(DXDTS(3,IDX),U),ENDT=$P(DXDTS(3,IDX),U,2)
38 . . ;---
39 . . S TMP=$$UPDNDX(STDT,ENDT)
40 . . I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
41 . . ;---
42 . . S DATE=$O(@XREF@(STDT),-1)
43 . . F S DATE=$O(@XREF@(DATE)) Q:'DATE!(DATE'<ENDT) D
44 . . . S INIEN=""
45 . . . F S INIEN=$O(@XREF@(DATE,INIEN)) Q:'INIEN D
46 . . . . S IENS=INIEN_","
47 . . . . ;--- Skip non-PTF records
48 . . . . S TYPE=$$GET1^DIQ(45,IENS,11,"I",,"RORMSG")
49 . . . . I $G(DIERR) D S ERRCNT=ERRCNT+1 Q
50 . . . . . D DBS^RORERR("RORMSG",-9,,RORDFN,45,IENS)
51 . . . . Q:TYPE'="1"
52 . . . . ;--- Generate the PV1 segment
53 . . . . S TMP=$$PV1(INIEN,RORDFN)
54 . . . . I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
55 . . . . ;--- Reference for the corresponding OBR and OBX segments
56 . . . . S:TMP'="S" PV1CNT=PV1CNT+1,^TMP("RORHL08",$J,PV1CNT)=INIEN
57 ;
58 ;--- OBR and OBX Segments
59 I RORTY="OBR" D K ^TMP("RORHL08",$J)
60 . S PV1CNT=0
61 . F S PV1CNT=$O(^TMP("RORHL08",$J,PV1CNT)) Q:PV1CNT'>0 D
62 . . S INIEN=+$G(^TMP("RORHL08",$J,PV1CNT)) Q:INIEN'>0
63 . . ;---
64 . . S TMP=$$OBR(INIEN,RORDFN)
65 . . I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
66 . . ;---
67 . . S TMP=$$OBX^RORHL081(INIEN,RORDFN)
68 . . I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
69 ;
70 ;--- Check for errors
71 Q $S(RC<0:RC,1:ERRCNT)
72 ;
73 ;***** MERGES THE TIME FRAME INTO THE LIST
74 ;
75 ; .DXDTS Reference to a local array where the time frames
76 ; are returned: DXDTS(StartDT)=StartDT^EndDT.
77 ;
78 ; STDT Start date
79 ; ENDT End date
80 ;
81 ; This procedure merges the provided time frame [STDT,ENDT[ into
82 ; the list stored in the ^TMP("RORPTF",$J,"DTF") global node and
83 ; returns a list of time frames that should be updated into a
84 ; local array defined by the DXDTS parameter.
85 ;
86 ; Variants of positional relationship of the existing time frames
87 ; and the one that is being added to the list:
88 ;
89 ; (1) +--------TMP +----------+
90 ; STDT--------ENDT
91 ;
92 ; (2) +--------TMP
93 ; STDT--------ENDT
94 ;
95 ; (3) TMP--------+
96 ; STDT--------ENDT
97 ;
98 ; (4) +--------+
99 ; STDT------------------ENDT
100 ;
101MERGEDTF(DXDTS,STDT,ENDT) ;
102 N DATE,DXE,DXS,ENDT0,EXIT,STDT0,TMP K DXDTS
103 Q:STDT>ENDT
104 S STDT0=STDT,(DXE,ENDT0)=ENDT
105 ;--- Merge time frames if possible
106 S DATE=$O(^TMP("RORPTF",$J,"DTF",ENDT)),EXIT=0
107 F S DATE=$O(^TMP("RORPTF",$J,"DTF",DATE),-1) Q:DATE="" D Q:EXIT
108 . S DXS=$P(^TMP("RORPTF",$J,"DTF",DATE),U,2)
109 . I DXS<STDT S EXIT=1 Q ; (1)
110 . S:DXS>ENDT ENDT=DXS,DFLT=0 ; (2)
111 . S:DXS<DXE DXDTS(DXS)=DXS_U_DXE
112 . S DXE=$P(^TMP("RORPTF",$J,"DTF",DATE),U)
113 . S:DXE<STDT STDT=DXE,DFLT=0 ; (3)
114 . K ^TMP("RORPTF",$J,"DTF",DATE)
115 S:DXE>STDT0 DXDTS(STDT0)=STDT0_U_DXE
116 ;--- Store the new time frame
117 S ^TMP("RORPTF",$J,"DTF",STDT)=STDT_U_ENDT
118 Q
119 ;
120 ;***** OBR SEGMENT BUILDER (INPATIENT)
121 ;
122 ; RORIEN IEN of file #45
123 ;
124 ; RORDFN DFN of Patient Record in File #2
125 ;
126 ; Return Values:
127 ; <0 Error Code
128 ; 0 Ok
129 ; >0 Non-fatal error(s)
130 ;
131OBR(RORIEN,RORDFN) ;
132 N CS,ERRCNT,IENS,OBDT,RC,RORMSG,RORSEG,TMP
133 S (ERRCNT,RC)=0
134 D ECH^RORHL7(.CS)
135 ;
136 ;--- Initialize the segment
137 S RORSEG(0)="OBR"
138 ;
139 ;--- OBR-3 - Order Number (IEN in the PTF file #45)
140 S RORSEG(3)=RORIEN
141 ;
142 ;--- OBR-4 - Universal Service ID
143 S RORSEG(4)="IP"_CS_"Inpatient"_CS_"C4"
144 ;
145 ;--- OBR-7 -Observation Date/Time (Admission Date/Time) *KEY*
146 S IENS=RORIEN_","
147 S OBDT=$$GET1^DIQ(45,IENS,2,"I",,"RORMSG")
148 Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,RORDFN,45,IENS)
149 ;---
150 S OBDT=$$FMTHL7^XLFDT(OBDT)
151 Q:OBDT'>0 $$ERROR^RORERR(-95,,,RORDFN,45,IENS,2)
152 S RORSEG(7)=OBDT
153 ;
154 ;--- OBR-24 - Diagnostic Service ID
155 S RORSEG(24)="PHY"
156 ;
157 ;--- OBR-44 - Division
158 S RORSEG(44)=$$SITE^RORUTL03(CS)
159 ;
160 ;--- Store the segment
161 D ADDSEG^RORHL7(.RORSEG)
162 Q ERRCNT
163 ;
164 ;***** PV1 SEGMENT BUILDER (INPATIENT)
165 ;
166 ; RORIEN IEN of file #45
167 ;
168 ; RORDFN DFN of Patient Record in File #2
169 ;
170 ; Return Values:
171 ; <0 Error Code
172 ; 0 Ok
173 ; "S" No inpatient data
174 ; >0 Non-fatal error(s)
175 ;
176PV1(RORIEN,RORDFN) ;
177 N BUF,CS,ERRCNT,IENS,RC,RORBUF,RORMSG,RORSEG,TMP
178 S (ERRCNT,RC)=0
179 D ECH^RORHL7(.CS)
180 ;
181 ;--- Load the data
182 S IENS=RORIEN_","
183 D GETS^DIQ(45,IENS,"2;70;71;72","I","RORBUF","RORMSG")
184 I $G(DIERR) D S ERRCNT=ERRCNT+1
185 . D DBS^RORERR("RORMSG",-9,,RORDFN,45,IENS)
186 ;
187 ;--- Initialize the segment
188 S RORSEG(0)="PV1"
189 ;
190 ;--- PV1-2 - Patient Class
191 S RORSEG(2)="I" ; I - Inpatient
192 ;
193 ;--- PV1-3 - Assigned Patient Location (Station Number)
194 S TMP=$E($P($$SITE^VASITE,U,3),1,3) ; Strip the suffix
195 Q:TMP'>0 $$ERROR^RORERR(-100,,,,"No station number","$$SITE^VASITE")
196 S RORSEG(3)=TMP
197 ;
198 ;--- PV1-6 - Prior Patient Location (Bed Section at Discharge)
199 I $G(RORBUF(45,IENS,71,"I"))>0 D
200 . S BUF=""
201 . S $P(BUF,CS,3)=RORBUF(45,IENS,71,"I") ; Bed Section IEN
202 . S TMP=$$EXTERNAL^DILFD(45,71,,$P(BUF,CS,3),"RORMSG")
203 . I $G(DIERR) D S ERRCNT=ERRCNT+1 Q
204 . . D DBS^RORERR("RORMSG",-99,,RORDFN,45,IENS)
205 . S $P(BUF,CS,9)=$$ESCAPE^RORHL7(TMP) ; Bed Section Name
206 . S RORSEG(6)=BUF
207 ;
208 ;--- PV1-19 - Visit Number (IEN in the PTF file #45) *KEY*
209 S RORSEG(19)=RORIEN
210 ;
211 ;--- PV1-36 - Discharge Disposition
212 S RORSEG(36)=$G(RORBUF(45,IENS,72,"I"))
213 ;
214 ;--- PV1-44 - Admit Date/Time *KEY*
215 S TMP=$$FMTHL7^XLFDT($G(RORBUF(45,IENS,2,"I")))
216 Q:TMP'>0 $$ERROR^RORERR(-95,,,RORDFN,45,IENS,2)
217 S RORSEG(44)=TMP
218 ;
219 ;--- PV1-45 - Discharge Date/Time
220 S RORSEG(45)=$$FM2HL^RORHL7($G(RORBUF(45,IENS,70,"I")))
221 ;
222 ;--- Store the segment
223 D ADDSEG^RORHL7(.RORSEG)
224 Q ERRCNT
225 ;
226 ;***** UPDATES TEMPORARY PTF INDEX
227 ;
228 ; STDT Start date
229 ; ENDT End date
230 ;
231 ; This function updates the temporary PTF index with records
232 ; closed in the provided time frame.
233 ;
234 ; Return Values:
235 ; <0 Error Code
236 ; 0 Ok
237 ;
238UPDNDX(STDT,ENDT) ;
239 N DATE,DXDTS,IDX,IEN,PATIEN,RC,RORMSG,TMP
240 ;--- Get time frames that should be processed
241 D MERGEDTF(.DXDTS,STDT,ENDT) Q:$D(DXDTS)<10 0
242 ;--- Update the index
243 S IDX=0
244 F S IDX=$O(DXDTS(IDX)) Q:IDX'>0 D
245 . S STDT=$P(DXDTS(IDX),U),ENDT=$P(DXDTS(IDX),U,2)
246 . S DATE=$O(^DGP(45.84,"AC",STDT),-1)
247 . F S DATE=$O(^DGP(45.84,"AC",DATE)) Q:'DATE!(DATE'<ENDT) D
248 . . S IEN=0
249 . . F S IEN=$O(^DGP(45.84,"AC",DATE,IEN)) Q:IEN'>0 D
250 . . . ;--- Patient IEN (entries of file #45.84 are DINUM'ed)
251 . . . S PATIEN=$$GET1^DIQ(45,IEN,.01,"I",,"RORMSG")
252 . . . I $G(DIERR) D DBS^RORERR("RORMSG",-99,,,45,IEN) Q
253 . . . ;--- Create index entry
254 . . . S:PATIEN>0 ^TMP("RORPTF",$J,"PDI",PATIEN,DATE,IEN)=""
255 ;---
256 Q 0
Note: See TracBrowser for help on using the repository browser.