source: FOIAVistA/trunk/r/DSS_EXTRACTS-ECX/ECXUTL4.m@ 876

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

initial load of FOIAVistA 6/30/08 version

File size: 7.8 KB
Line 
1ECXUTL4 ;ALB/ESD - Utilities for DSS Extracts ; 11/26/07 10:58am
2 ;;3.0;DSS EXTRACTS;**39,41,46,49,78,92,105**;Dec 22,1997;Build 70
3 ;
4OBSPAT(ECXIO,ECXTS,DSSID) ;
5 ; Get observation patient indicator from DSS TREATING SPECIALTY
6 ; TRANSLATION file (#727.831) or DSS Identifier
7 ;
8 ; Input:
9 ; ECXIO - Inpatient/Outpatient indicator
10 ; ECXTS - Treating specialty (from file #42.4)
11 ; DSSID - DSS Identifier
12 ;
13 ;Output:
14 ; ECXOBS - Observation patient indicator (YES/NO)
15 ;
16 ;- Check input vars
17 S ECXIO=$G(ECXIO),ECXTS=+$G(ECXTS),DSSID=+$G(DSSID)
18 S ECXOBS=""
19 D
20 .;- Look up obs patient indicator if treating spec is in file #727.831
21 . I $G(^ECX(727.831,ECXTS,0)) S ECXOBS=$P($G(^ECX(727.831,ECXTS,0)),"^",4)
22 . I ECXOBS'="" S ECXOBS=$S(ECXOBS="Y":"YES",1:"NO") Q
23 .;
24 .;- If outpatient and TS not in file, AND Feeder Key (CLI) or DSS ID
25 .;- (MTL,IVP,ECQ,QSR,NOS,SUR) is 290-296, Observation Patient Ind=YES
26 . I ECXIO="O",ECXOBS="",DSSID D
27 .. I $E(DSSID,1,3)>289&($E(DSSID,1,3)<297) S ECXOBS="YES"
28 .. E S ECXOBS="NO"
29 Q $S(ECXOBS'="":ECXOBS,1:"NO")
30 ;
31INOUTP(ECXTS) ;
32 ; Get inpatient/outpatient indicator from DSS TREATING SPECIALTY
33 ; TRANSLATION file (#727.831)
34 ;
35 ; Input:
36 ; ECXTS - Treating specialty
37 ;
38 ; Output:
39 ; Inpatient/Outpatient indicator (I/O)
40 ;
41 S ECXTS=+$G(ECXTS)
42 S ECXIO=""
43 ;
44 ;- Look up inpat/outpat indicator if treating spec is in file
45 I $G(^ECX(727.831,ECXTS,0)) S ECXIO=$P($G(^ECX(727.831,ECXTS,0)),"^",5)
46 Q $S(ECXIO'="":ECXIO,1:"I")
47 ;
48ENCNUM(ECXIO,ECXSSN,ECXADT,ECXVDT,ECXTRT,ECXOBS,ECXEXT,ECXSTP,ECXSTP2) ;
49 ; Get encounter number
50 ;
51 ; Input:
52 ; ECXIO - Inpat/Outpat indicator = I or O
53 ; ECXSSN - Patient SSN
54 ; ECXADT - Admit Date
55 ; ECXVDT - Visit Date
56 ; ECXTRT - Treating Spec
57 ; ECXOBS - Observation Pat Indicator
58 ; ECXEXT - Extract
59 ; ECXSTP - Stop Code (or stop code related) variable
60 ; ECXSTP2 - Stop Code (or stop code related) addtl variable
61 ; (used for SUR and ECS)
62 ;
63 ;Output:
64 ; Encounter Number
65 ;
66 N ENCNUM,ECXDATE,ECXSTCD
67 S (ENCNUM,ECXSTCD)=""
68 ;
69 ;- Check input vars
70 S ECXEXT=$G(ECXEXT),ECXIO=$G(ECXIO),ECXOBS=$G(ECXOBS),ECXTRT=+$G(ECXTRT)
71 S ECXSTP=+$G(ECXSTP),ECXSTP2=+$G(ECXSTP2)
72 S ECXADT=+$G(ECXADT),ECXVDT=+$G(ECXVDT)
73 ;
74 ;- Don't use pseudo-SSN in encounter number
75 S ECXSSN=$E($G(ECXSSN),1,9)
76 ;
77 D
78 . ;- Inpatient
79 . I ECXIO="I",ECXADT,ECXSSN'="" D Q
80 .. S ECXDATE=$$ADMITDT(ECXADT)
81 .. I ECXDATE'="" S ENCNUM=ECXSSN_ECXDATE_"I"
82 . ;
83 . ;- Outpatient branch
84 . I ECXIO="O" D
85 .. ;- Observation patient (outpatient)
86 .. I ECXOBS="YES",ECXSSN'="" D Q
87 ... ;
88 ... S ECXDATE=$S(ECXADT:$$JULDT(ECXADT),1:$$JULDT(ECXVDT))
89 ... S ECXSTCD=$S(+$P($G(^ECX(727.831,ECXTRT,0)),"^",6):+$P($G(^ECX(727.831,ECXTRT,0)),"^",6),1:+$E(ECXSTP,1,3))
90 ... Q:ECXDATE=""!(ECXSTCD="")
91 ... S ENCNUM=ECXSSN_ECXDATE_ECXSTCD
92 .. ;
93 .. ;- Outpatient (no observation pat)
94 .. I ECXOBS="NO",ECXVDT,ECXSSN'="" D Q
95 ... ;
96 ... ;- ADM, MOV, TRT have no outpat encounter number
97 ... I ECXEXT="ADM"!(ECXEXT="MOV")!(ECXEXT="TRT") Q
98 ... ;
99 ... ;- Use 1st 3 chars of DSS ID for NOS and ECQ (feeder key for CLI)
100 ... ;- Use observation stop code for IVP
101 ... I ECXEXT="CLI"!(ECXEXT="NOS")!(ECXEXT="ECQ")!(ECXEXT="IVP") S ECXSTCD=+$E(ECXSTP,1,3) Q:'ECXSTCD
102 ... ;
103 ... ;- Use cost center to obtain stop code for ECS
104 ... I ECXEXT="ECS" D Q:'ECXSTCD
105 .... S ECXSTCD=$$ECSCOST(ECXSTP2)
106 ....;
107 ....;- If no cost center, use 1st 3 chars of DSS ID
108 .... I ECXSTCD="" S ECXSTCD=+$E(ECXSTP,1,3)
109 ... ;
110 ... ;- These extracts have predetermined stop code values
111 ... I ECXEXT="DEN" S ECXSTCD=180
112 ... I ECXEXT="PRE"!(ECXEXT="UDP") S ECXSTCD=160
113 ... I ECXEXT="LAB"!(ECXEXT="LAR")!(ECXEXT="LBB") S ECXSTCD=108
114 ... I ECXEXT="MTL" S ECXSTCD=538
115 ... I ECXEXT="NUR" S ECXSTCD=950
116 ... I ECXEXT="PRO" S ECXSTCD=423
117 ... I ECXEXT="NUT" S ECXSTCD="NUT"
118 ... ;
119 ... ;- If Imaging Type fld=2, use 109 otherwise use 105
120 ... I ECXEXT="RAD" S ECXSTCD=$S(ECXSTP=2:109,1:105)
121 ... ;
122 ... ;- Use DSS STOP CODE fld if populated or if SURG SPEC fld=59 use 430
123 ... ;- otherwise if null use 429
124 ... I ECXEXT="SUR" S ECXSTCD=$S(ECXSTP:ECXSTP,ECXSTP2=59:430,1:429)
125 ... ;
126 ... ;- Get Julian Date
127 ... S ECXDATE=$$JULDT(ECXVDT)
128 ... I ECXDATE'="" S ENCNUM=ECXSSN_ECXDATE_ECXSTCD
129 Q ENCNUM
130 ;
131ADMITDT(ECXINDT) ; Returns date in YYMMDD format
132 ;
133 ; Input:
134 ; ECXINDT - Date (can also include time) in internal FM format
135 ;
136 ;Output:
137 ; Date in YYMMDD form
138 ;
139 N ECXDT
140 S ECXDT=""
141 S ECXINDT=+$G(ECXINDT)
142 ;
143 ;- If no input or full FM date not passed in, quit
144 I 'ECXINDT!($L(ECXINDT)<7) G ADMTDTQ
145 ;
146 ;- Date in YYMMDD form
147 S ECXDT=$TR($$FMTE^XLFDT(ECXINDT,"4DF")," /","0")
148ADMTDTQ Q ECXDT
149 ;
150 ;
151JULDT(ECXINDT) ; Returns Julian Date in MMDDD format
152 ;
153 ; Input:
154 ; ECINDT - Date (can also include time) in internal FM format
155 ;
156 ;Output:
157 ; Julian date in MM_DDD form
158 ;
159 N ECXDDD,ECXDT,ECXJUL,ECXMM
160 S (ECXDDD,ECXMM)=""
161 ;
162 ;- If no input or full FM date not passed in, quit
163 S ECXINDT=+$G(ECXINDT)
164 I 'ECXINDT!($L(ECXINDT)<7) G JULDTQ
165 ;
166 ;- Extract date portion
167 S ECXDT=$E(ECXINDT,1,7)
168 ;
169 ;- Get month (MM)
170 S ECXMM=$E(ECXINDT,2,3)
171 ;
172 ;- Number of day within year (DDD)
173 S ECXDDD=$$RJ^XLFSTR($$FMDIFF^XLFDT(ECXDT,$E(ECXDT,1,3)_"0101",1)+1,3,"0")
174JULDTQ Q ECXMM_ECXDDD
175 ;
176CNHSTAT(ECXDFN) ; Get CNH (Contract Nursing Home) status
177 ;
178 ; Input:
179 ; ECXDFN - Patient DFN
180 ;
181 ;Output:
182 ; CNH status (YES/NO)
183 ;
184 N ECXCNH
185 S ECXDFN=+$G(ECXDFN)
186 S ECXCNH=$P($G(^DPT(ECXDFN,"NHC")),U)
187 Q $S(ECXCNH="Y":"YES",ECXCNH="N":"NO",1:"")
188 ;
189CANC(ECXNOR,ECXTMOR) ; Get Surgery Cancelled/Aborted Status
190 ;
191 ; Function called after determining CANCEL DATE in SURGERY record exists
192 ;
193 ; Input:
194 ; ECXNOR - Non-OR DSS ID
195 ; ECXTMOR - Time Pat in OR
196 ;
197 ;Output:
198 ; Cancelled/aborted status (C/A)
199 ;
200 N ECXCANC
201 S ECXCANC=""
202 S ECXNOR=$G(ECXNOR)
203 ;
204 ;- If Non-OR DSS ID or Time Pat in OR, ECXCANC = "A" else = "C"
205 D
206 . I ECXNOR'=""&(ECXNOR'="UNKNOWN") S ECXCANC="A" Q
207 . I +$G(ECXTMOR) S ECXCANC="A" Q
208 . S ECXCANC="C"
209 Q ECXCANC
210 ;
211ECSCOST(ECXCOST) ;Get ECS extract stop code based on cost center
212 ;
213 ;
214 ; Input:
215 ; ECXCOST - ECS extract cost center
216 ;
217 ;Output:
218 ; ECS extract stop code
219 ;
220 N ECXFND,ECXSTOP,I
221 S ECXFND=0
222 S ECXSTOP=""
223 S ECXCOST=+$G(ECXCOST)
224 D
225 . I 'ECXCOST Q
226 . F I=1:1 Q:ECXFND!($P($T(COST+I),";;",2)="END") D
227 .. I ECXCOST=$P($T(COST+I),";;",2) S ECXSTOP=$P($T(COST+I),";;",3),ECXFND=1
228 Q ECXSTOP
229 ;
230COST ;- ECS Cost Center and stop code
231 ;;833100;;652
232 ;;833200;;653
233 ;;833300;;681
234 ;;834100;;651
235 ;;834200;;650
236 ;;834300;;681
237 ;;834400;;654
238 ;;834500;;681
239 ;;834600;;681
240 ;;834700;;681
241 ;;834800;;681
242 ;;834900;;681
243 ;;836100;;654
244 ;;836200;;654
245 ;;END
246 ;
247HNCI(ECXDFN) ; Get head & neck cancer indicator
248 ;
249 ; Input:
250 ; ECXDFN - Patient DFN
251 ;
252 ;Output:
253 ; Head/Neck CA DX (Y/N)
254 ;
255 N ECXHNCI,DGNT
256 S ECXHNCI=""
257 S ECXDFN=+$G(ECXDFN) I ECXDFN D
258 .I $$GETCUR^DGNTAPI(ECXDFN,"DGNT") S ECXHNCI=$P(DGNT("HNC"),U)
259 Q ECXHNCI
260 ;
261TSMAP(ECXTS) ;Determines DSS Identifier for the following observation
262 ; treating specialty
263 ; Input:
264 ; ECXTS - Observation Treating Specialty
265 ;
266 ; Output:
267 ; DSS Identifier (Stop Code)
268 ;
269 N TS,SC,I
270 S TS="^18^23^24^36^41^65^94^",SC="^293^295^290^294^296^291^292^"
271 F I=1:1:$L(TS) Q:$P(TS,"^",I)=ECXTS
272 Q $P(SC,"^",I)_"000"
273OEFDATA ;
274 ;get patient OEF/OIF status and date of return
275 S (ECXOEF,ECXOEFDT)=""
276 I $G(VASV(11))>0 S ECXOEF=ECXOEF_"OIF"
277 I $G(VASV(12))>0 S ECXOEF=ECXOEF_"OEF"
278 I $G(VASV(13))>0 S ECXOEF=ECXOEF_"UNK"
279 I ECXOEF'="" D
280 . S ECXOEFDT=""
281 . I $G(VASV(11))>0 S ECXOEFDT=$P($G(VASV(11,$G(VASV(11)),3)),"^")
282 . I $G(VASV(12))>0,$P($G(VASV(12,$G(VASV(12)),3)),"^")>ECXOEFDT S ECXOEFDT=$P($G(VASV(12,$G(VASV(12)),3)),"^")
283 . I $G(VASV(13))>0,$P($G(VASV(13,$G(VASV(13)),3)),"^")>ECXOEFDT S ECXOEFDT=$P($G(VASV(13,$G(VASV(13)),3)),"^")
284 . I ECXOEFDT>0 S ECXOEFDT=17000000+ECXOEFDT
285 ;
286 S ECXPAT("ECXOEF")=ECXOEF
287 S ECXPAT("ECXOEFDT")=ECXOEFDT
288 Q
Note: See TracBrowser for help on using the repository browser.