source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/ROREXT02.m@ 785

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

initial load of FOIAVistA 6/30/08 version
File size: 7.6 KB
Line 
1ROREXT02 ;HCIOFO/SG - DEFAULT MESSAGE BUILDER ; 12/7/05 10:44am
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 Q
5 ;
6 ;***** CHECKS IF DEMOGRAPHIC DATA HAS BEEN UPDATED
7 ;
8 ; .RGIENLST Reference to a local array containing registry
9 ; IENs as subscripts and IENs of the corresponding
10 ; patient's registry records as values.
11 ;
12 ; Return Values:
13 ; <0 Error Code
14 ; 0 Demographic data is unchanged
15 ; >0 Demographic data has been updated
16 ;
17DEMCHK(RGIENLST) ;
18 N DEM,IENS,RC,REGIEN,RORMSG
19 S (DEM,RC,REGIEN)=0
20 F S REGIEN=$O(RGIENLST(REGIEN)) Q:REGIEN'>0 D Q:DEM!(RC<0)
21 . S IENS=+RGIENLST(REGIEN)_"," Q:IENS'>0
22 . S DEM=+$$GET1^DIQ(798,IENS,4,"I",,"RORMSG")
23 . S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,,798,IENS)
24 Q $S(RC<0:RC,1:DEM)
25 ;
26 ;***** EXTRACTS AND PREPARES LABORATORY DATA
27 ;
28 ; PTIEN Patient IEN
29 ;
30 ; .DXDTS Reference to a local variable where the
31 ; data extraction time frames are stored.
32 ;
33 ; [HDTMODE] If this parameter is defined and non-zero, start and
34 ; end dates are specimen collection dates. Otherwise,
35 ; they are dates of the results.
36 ;
37 ; The function uses node ^TMP("RORTMP",$J) as a temporary storage.
38 ;
39 ; Return Values:
40 ; <0 Error Code
41 ; 0 Ok
42 ;
43LABDATA(PTIEN,DXDTS,HDTMODE) ;
44 N ENDT,IDX,RC,RORTMP,STDT,TMP
45 S RORTMP=$$ALLOC^RORTMP()
46 S (IDX,RC)=0
47 F S IDX=$O(DXDTS(1,IDX)) Q:IDX'>0 D Q:RC<0
48 . S STDT=$P(DXDTS(1,IDX),U),ENDT=$P(DXDTS(1,IDX),U,2)
49 . ;--- Get the Lab results
50 . K @RORTMP S TMP=$S($G(HDTMODE):"^CD",1:"^RAD")
51 . S RC=$$LABRSLTS^RORUTL02(PTIEN,STDT_TMP,ENDT_TMP,RORTMP)
52 . Q:RC<0
53 . ;--- Call the Lab data post-processor
54 . S RC=$$LABPROC(RORTMP,PTIEN)
55 . ;---
56 D FREE^RORTMP(RORTMP)
57 Q $S(RC<0:RC,1:0)
58 ;
59 ;***** LABORATORY DATA POST-PROCESSOR
60 ;
61 ; ROR8TMP Closed root of the array (local or global), which
62 ; contains the data loaded by the $$GCPR^LA7QRY
63 ;
64 ; PTIEN Patient IEN
65 ;
66 ; Return Values:
67 ; <0 Error Code
68 ; 0 Ok
69 ;
70LABPROC(ROR8TMP,PTIEN) ;
71 N BUF,CS,DFLTSITE,FS,I,J,LABC,SEG,TMP
72 ;--- Extract separators from the MSH segment
73 S BUF=$G(@ROR8TMP@(1))
74 S:$E(BUF,1,3)="MSH" CS=$E(BUF,5)
75 S:$G(CS)="" CS="^"
76 ;--- Initialize constants and variables
77 S LABC="LABC"_CS_"Lab Comment"_CS_"VA080"
78 ;--- Get the default station number and name
79 S DFLTSITE=$$SITE^RORUTL03(CS)
80 ;
81 ;--- Add the results to the message
82 S I=0
83 F S I=$O(@ROR8TMP@(I)) Q:I="" D
84 . ;--- Load the full segment
85 . D LOADSEG^RORHL7A(.SEG,$NA(@ROR8TMP@(I))) Q:$G(SEG(0))=""
86 . D
87 . . ;--- Use the default station if the local one is missing
88 . . I SEG(0)="OBX" D Q
89 . . . S:$P($G(SEG(15)),CS)="" SEG(15)=DFLTSITE
90 . . ;--- Leave only the code of the Provider
91 . . I SEG(0)="OBR" D Q
92 . . . S SEG(16)=+$G(SEG(16)),SEG(24)="LAB"
93 . . ;--- Replace NTE's with OBX's
94 . . I SEG(0)="NTE" D Q
95 . . . K TMP M TMP=SEG(3) K SEG
96 . . . S SEG(0)="OBX"
97 . . . S SEG(2)="ST",SEG(3)=LABC,SEG(4)="LCOMM"
98 . . . M SEG(5)=TMP
99 . . . S SEG(11)="F"
100 . . ;--- Skip all other segments
101 . . K SEG
102 . ;--- Store the segment
103 . D:$D(SEG)>1 ADDSEG^RORHL7(.SEG)
104 Q 0
105 ;
106 ;***** EXTRACTS PATIENT'S DATA AND CREATES THE MESSAGE BODY
107 ;
108 ; PTIEN Patient IEN
109 ;
110 ; .RGIENLST Reference to a local array containing registry
111 ; IENs as subscripts and IENs of the corresponding
112 ; patient's registry records as values.
113 ;
114 ; .DXDTS Either a single time frame in StartDate^EndDate
115 ; format or a reference to a local variable containing
116 ; the list of data extraction time frames. The main
117 ; time frame should be stored in the root node:
118 ;
119 ; DXDTS( MainStartDate^MainEndDate (FileMan)
120 ; DataArea,
121 ; i) StartDate^EndDate (FileMan)
122 ;
123 ; See the $$DXPERIOD^ROREXTUT function for details.
124 ;
125 ; [HDTMODE] This parameter is defined and non-zero during the
126 ; historical data extraction.
127 ;
128 ; Return Values:
129 ; <0 Error Code
130 ; 0 Ok
131 ; >0 Nothing to send
132 ;
133MESSAGE(PTIEN,RGIENLST,DXDTS,HDTMODE) ;
134 N RORDEM ; Update demographics
135 ;
136 N CLINPTR,CSRPTR,DEMPTR,PV1PTR,RC,REGIEN,RORMSG,RORPTR,TMP
137 S HDTMODE=+$G(HDTMODE)
138 ;--- If only the main time frame is provided then
139 ;--- generate the data-specific ones automatically
140 I $D(DXDTS)<10 D D DXMERGE^ROREXTUT(.DXDTS)
141 . D DXADD^ROREXTUT(.DXDTS,$P(DXDTS,U),$P(DXDTS,U,2),0,1)
142 ;--- Initialize variables
143 S RC=$$INIT^RORHL7() Q:RC<0 RC
144 S RORDEM=$$DEMCHK(.RGIENLST)
145 ;
146 ;=== Demographic data segments
147 S DEMPTR=$$PTR^RORHL7
148 S RC=$$PID^RORHL01(PTIEN) Q:RC<0 RC
149 ;--- Period of Servise
150 S RC=$$ZSP^RORHL01(PTIEN) Q:RC<0 RC
151 ;--- Rated Disabilities
152 S RC=$$ZRD^RORHL01(PTIEN) Q:RC<0 RC
153 ;
154 ;=== Inpatient and Outpatient Encounter Data
155 S PV1PTR=$$PTR^RORHL7
156 ;--- Inpatient
157 S RC=$$EN1^RORHL08(PTIEN,.DXDTS,"PV1") Q:RC<0 RC
158 ;--- Outpatient
159 S RC=$$EN1^RORHL09(PTIEN,.DXDTS,"PV1") Q:RC<0 RC
160 ;
161 ;=== Required CSR segment (dummy)
162 S CSRPTR=$$PTR^RORHL7
163 S RC=$$CSR^RORHL02(,PTIEN) Q:RC<0 RC
164 ;
165 ;=== Add other encounter data segments
166 S CLINPTR=$$PTR^RORHL7
167 ;---Inpatient
168 S RC=$$EN1^RORHL08(PTIEN,.DXDTS,"OBR") Q:RC<0 RC
169 ;--- Outpatient
170 S RC=$$EN1^RORHL09(PTIEN,.DXDTS,"OBR") Q:RC<0 RC
171 ;--- Radiology
172 S RC=$$EN1^RORHL04(PTIEN,.DXDTS) Q:RC<0 RC
173 ;--- Autopsy
174 S RC=$$EN1^RORHL05(PTIEN,.DXDTS) Q:RC<0 RC
175 ;--- Surgical Pathology
176 S RC=$$EN1^RORHL10(PTIEN,.DXDTS,HDTMODE) Q:RC<0 RC
177 ;--- Cytopathology
178 S RC=$$EN1^RORHL11(PTIEN,.DXDTS,HDTMODE) Q:RC<0 RC
179 ;--- Microbiology
180 S RC=$$EN1^RORHL12(PTIEN,.DXDTS,HDTMODE) Q:RC<0 RC
181 ;--- EKG (Medical Procedures)
182 S RC=$$EN1^RORHL13(PTIEN,.DXDTS) Q:RC<0 RC
183 ;--- Allergy
184 S RC=$$EN1^RORHL14(PTIEN,.DXDTS) Q:RC<0 RC
185 ;--- IV
186 S RC=$$EN1^RORHL15(PTIEN,.DXDTS) Q:RC<0 RC
187 ;--- Vitals
188 S RC=$$EN1^RORHL16(PTIEN,.DXDTS) Q:RC<0 RC
189 ;--- Problem List
190 S RC=$$EN1^RORHL17(PTIEN,.DXDTS) Q:RC<0 RC
191 ;--- Lab data
192 S RC=$$LABDATA(PTIEN,.DXDTS,HDTMODE) Q:RC<0 RC
193 ;--- Pharmacy
194 S RC=$$EN1^RORHL03(PTIEN,.DXDTS) Q:RC<0 RC
195 ;
196 ;=== Analyze the structure of the message
197 S RORPTR=$$PTR^RORHL7
198 ;--- If the demographic data has not changed since the previous
199 ; data extraction and no clinical data has been added to the
200 ;--- message, then remove the demographic section completely.
201 I 'RORDEM,RORPTR'>CLINPTR,CSRPTR'>PV1PTR D
202 . D ROLLBACK^RORHL7(DEMPTR,1) S CLINPTR=0
203 ;
204 ;=== Registry Data
205 S REGIEN=0
206 F S REGIEN=$O(RGIENLST(REGIEN)),RC=0 Q:REGIEN'>0 D Q:RC<0
207 . S IEN=+RGIENLST(REGIEN) Q:IEN'>0
208 . ;--- If no clinical or demographics data is sent and the local
209 . ; registry data has not been modified since the last data
210 . ;--- extraction, then do not include the registry data section.
211 . I 'CLINPTR D Q:RC
212 . . S RC='$$GET1^DIQ(798,IEN_",",5,"I",,"RORMSG")
213 . . S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,PTIEN,798,IEN_",")
214 . ;---
215 . I $G(ROREXT("MSGBLD",REGIEN))'="" D
216 . . X "S RC="_ROREXT("MSGBLD",REGIEN)_"(IEN,PTIEN,.DXDTS)"
217 . E S RC=$$REGDATA(IEN,PTIEN,.DXDTS)
218 ;
219 ;=== Analyze the structure of the message
220 S RORPTR=$$PTR^RORHL7
221 Q (RORPTR'>DEMPTR)
222 ;
223 ;***** EXTRACTS REGISTRY-SPECIFIC DATA
224 ;
225 ; RORIEN IEN of the patient record in the registry
226 ;
227 ; PTIEN Patient IEN
228 ;
229 ; .DXDTS Data extraction time frames
230 ;
231 ; [HDTMODE] This parameter is defined and non-zero during the
232 ; historical data extraction.
233 ;
234 ; Return Values:
235 ; <0 Error Code
236 ; 0 Ok
237 ; >0 Nothing to send
238 ;
239REGDATA(RORIEN,PTIEN,DXDTS,HDTMODE) ;
240 N IENS,RC
241 S IENS=RORIEN_","
242 S RC=$$PID^RORHL01(PTIEN) Q:RC<0 RC
243 S RC=$$CSR^RORHL02(IENS,PTIEN) Q:RC<0 RC
244 S RC=$$CSP^RORHL02(IENS,DXDTS) Q:RC<0 RC
245 Q 0
Note: See TracBrowser for help on using the repository browser.