source: WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXTRT1.m@ 975

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

initial load of WorldVistAEHR

File size: 5.2 KB
Line 
1ECXTRT1 ;ALB/JAP Treating Specialty Change Extract (cont) ; July 22, 1998
2 ;;3.0;DSS EXTRACTS;**8**;Dec 22, 1997
3 ;
4PREVTRT(ECXLOC,ECXDATE1,ECXDATE2,ECXTRTL,ECXLOS) ;find the date on which the change to the losing treat. spec. occurred
5 ; input
6 ; ECXLOC = local array built from ATS index on file #405 (passed by reference); required
7 ; ECXDATE1 = inverse date of current (new) ts movement; required)
8 ; ECXDATE2 = inverse date of previous (losing) ts movement; required
9 ; ECXTRTL = pointer value to file #45.7 for previous facility
10 ; treating specialty; required
11 ; output
12 ; ECXLOS = patients length of stay on previous (losing) ts (passed by reference)
13 ;
14 N DATE,DATE3,X,X1,X2
15 S DATE=ECXDATE2,DATE3="",ECXLOS=0
16 F S DATE=$O(ECXLOC(DATE)) Q:DATE="" S TRT=$O(ECXLOC(DATE,0)) Q:TRT'=ECXTRTL
17 ;if date=null, then get immediately previous date by reverse $o
18 ;if date=null, this gets the last date in ecxloc array, i.e., the admission ts movement
19 S DATE3=$O(ECXLOC(DATE),-1)
20 S X1=9999999.9999999-ECXDATE1,X2=9999999.9999999-DATE3 D ^%DTC
21 S ECXLOS=X S:ECXLOS>9999 ECXLOS=9999
22 Q
23 ;
24PREVATT(ECXLOC,ECXDATE1,ECXATTN,ECXDATE2,ECXATTL,ECXLOS) ;find the date on which the change to the losing attending occurred
25 ; input
26 ; ECXLOC = local array built from ATS index on file #405 (passed by reference); required
27 ; ECXDATE1 = inverse date of current (new) attending; required)
28 ; ECXATTN = specifier for current (new) attending; required
29 ; ECXDATE2 = inverse date of previous (losing) attending; required
30 ; ECXATTL = specifier for previous (losing) attending (passed by reference); required
31 ; output
32 ; ECXLOSA = patients length of stay with previous (losing) attending (passed by reference)
33 ;
34 N DATE,DATE3,X,X1,X2,TRT,REC,ATT,OUT
35 S (DATE,DATE3)=ECXDATE2,ECXLOSA="",OUT=0
36 I ECXATTL'="" D
37 .F S DATE=$O(ECXLOC(DATE)) Q:DATE="" S TRT=$O(ECXLOC(DATE,0)),REC=$O(ECXLOC(DATE,TRT,0)) D Q:OUT=1
38 ..S ATT=$P(ECXLOC(DATE,TRT,REC),U,3)
39 ..;if provider is changed, then quit without resetting date3, and quit loop
40 ..I ATT'="",ATT'=ECXATTL S OUT=1
41 ..;there's probably always data on attending, so this may not be needed;
42 ..;but if att=null, then dont know if provider in ecxattl was attending or not, so don't reset date3;
43 ..;reset date3 only if know for sure
44 ..I ATT=ECXATTL S DATE3=DATE
45 .;so date3 is earliest known date for attending specified in ecxattl
46 .S X1=9999999.9999999-ECXDATE1,X2=9999999.9999999-DATE3 D ^%DTC
47 .S ECXLOSA=X
48 ;theres probably always data on attending, so this may not be needed;
49 ;but if ecxattl is null, then need to find valid previous attending
50 I ECXATTL="" D
51 .;ecxattn will also be null if evaluating discharge movements
52 .F S DATE=$O(ECXLOC(DATE)) Q:DATE="" S TRT=$O(ECXLOC(DATE,0)),REC=$O(ECXLOC(DATE,TRT,0)) D Q:OUT=1
53 ..S ATT=$P(ECXLOC(DATE,TRT,REC),U,3)
54 ..;if no change in attending, then keep ecxlosa=null
55 ..I ATT'="",ATT=ECXATTN S OUT=1
56 ..I ATT'="",ATT'=ECXATTN D
57 ...;reset ecxattl to send back to caller and calculate los
58 ...S OUT=1,ECXATTL=ATT,DATE3=DATE
59 ...S X1=99999999.9999999-ECXDATE1,X2=9999999.9999999-DATE3 D ^%DTC
60 ...S ECXLOSA=X
61 ;it is possible that ecxattl and ecxlosa will still be null
62 S:ECXLOSA>9999 ECXLOSA=9999
63 Q
64 ;
65PREVPRV(ECXLOC,ECXDATE1,ECXPRVN,ECXDATE2,ECXPRVL,ECXLOS) ;find the date on which the change to the losing primary provider occurred
66 ; input
67 ; ECXLOC = local array built from ATS index on file #405 (passed by reference); required
68 ; ECXDATE1 = inverse date of current (new) primary provider; required)
69 ; ECXPRVN = specifier for current (new) primary provider; required
70 ; ECXDATE2 = inverse date of previous (losing) primary provider; required
71 ; ECXPRVL = specifier for previous (losing) primary provider 9passed by reference); required
72 ; output
73 ; ECXLOSP = patients length of stay with previous (losing) primary provider (passed by reference)
74 ;
75 N DATE,DATE3,X,X1,X2,TRT,REC,PRV,OUT
76 S (DATE,DATE3)=ECXDATE2,ECXLOSP="",OUT=0
77 I ECXPRVL'="" D
78 .F S DATE=$O(ECXLOC(DATE)) Q:DATE="" S TRT=$O(ECXLOC(DATE,0)),REC=$O(ECXLOC(DATE,TRT,0)) D Q:OUT=1
79 ..S PRV=$P(ECXLOC(DATE,TRT,REC),U,2)
80 ..;if provider is changed, then quit without resetting date3, and quit loop
81 ..I PRV'="",PRV'=ECXPRVL S OUT=1
82 ..;if prv=null, then don't know if provider in ecxprvl was patient's provider or not, so don't reset date3;
83 ..;reset date3 only if know for sure
84 ..I PRV=ECXPRVL S DATE3=DATE
85 .;so date3 is earliest known date for attending specified in ecxattl
86 .S X1=9999999.9999999-ECXDATE1,X2=9999999.9999999-DATE3 D ^%DTC
87 .S ECXLOSP=X
88 ;if ecxprvl is null, then need to find valid previous primary provider
89 I ECXPRVL="" D
90 .;ecxprvn will also be null if evaluating discharge movements
91 .F S DATE=$O(ECXLOC(DATE)) Q:DATE="" S TRT=$O(ECXLOC(DATE,0)),REC=$O(ECXLOC(DATE,TRT,0)) D Q:OUT=1
92 ..S PRV=$P(ECXLOC(DATE,TRT,REC),U,2)
93 ..;if no change in primary provider, then keep ecxlosp=null
94 ..I PRV'="",PRV=ECXPRVN S OUT=1
95 ..I PRV'="",PRV'=ECXPRVN D
96 ...;reset ecxprvl to send back to caller and calculate los
97 ...S OUT=1,ECXPRVL=PRV,DATE3=DATE
98 ...S X1=99999999.9999999-ECXDATE1,X2=9999999.9999999-DATE3 D ^%DTC
99 ...S ECXLOSP=X
100 ;it is possible that ecxprvl and ecxlosp will still be null
101 S:ECXLOSP>9999 ECXLOSP=9999
102 Q
Note: See TracBrowser for help on using the repository browser.