97 lines
6.8 KiB
Mathematica
97 lines
6.8 KiB
Mathematica
YSKFASI2 ;16IT/PTC - SUBSTANCE ABUSE ;9/4/01 13:40
|
|
;;5.01;MENTAL HEALTH;**73**;Dec 30, 1994
|
|
;
|
|
;Reference to ^DGPT( supported by IA #564
|
|
;Reference to ^SCE( supported by IA #402
|
|
;Reference to ^SCE("ADFN" supported by IA #402
|
|
;Reference to ^SCE("B" supported by IA #402
|
|
D NEW,ASI
|
|
Q
|
|
NEW ;decide if new patient
|
|
S YSKFDFN=0 F S YSKFDFN=$O(^TMP("XNNEW",$J,YSKFDFN)) Q:YSKFDFN'>0 S STOP=0,YSKFDT=$O(^TMP("XNNEW",$J,YSKFDFN,0)) Q:YSKFDT'>0 D
|
|
.I '$D(^TMP("24STAY",$J,YSKFDFN))&('$D(^UTILITY($J,"TRDOP",YSKFDFN))) Q ; not eligible to consider
|
|
.S X1=YSKFDT,X2=-90 D C^%DTC S YSKF90=(X-.001) S ^TMP("CHKDT",$J,YSKFDFN)=+^TMP("XNNEW",$J,YSKFDFN,YSKFDT)_U_YSKFDT_U_YSKF90
|
|
.I +^TMP("XNNEW",$J,YSKFDFN,YSKFDT)=1 S (NXTDT,NXTDT2)=YSKFDT F S NXTDT=$O(^TMP("XNNEW",$J,YSKFDFN,NXTDT)) Q:NXTDT'>0!(STOP=1) S X1=NXTDT,X2=NXTDT2 D ^%DTC D
|
|
..I X<91 K ^TMP("CHKDT",$J,YSKFDFN) S X1=NXTDT2,X2=-90 D C^%DTC S YSKF90=(X-.001) S STOP=1,^TMP("CHKDT",$J,YSKFDFN)=1_U_NXTDT2_U_YSKF90 Q ;PC 8/3/01
|
|
..I X>90 D
|
|
...I +^TMP("XNNEW",$J,YSKFDFN,NXTDT)=1 S NXTDT2=NXTDT Q
|
|
...I +^TMP("XNNEW",$J,YSKFDFN,NXTDT)=2 S X1=+^UTILITY($J,"FIRSTOP",YSKFDFN),X2=-90 D C^%DTC S YSKF90=(X-.001),STOP=1,^TMP("CHKDT",$J,YSKFDFN)=2_U_NXTDT_U_YSKF90 Q
|
|
.I +^TMP("XNNEW",$J,YSKFDFN,YSKFDT)=2 S X1=+^UTILITY($J,"FIRSTOP",YSKFDFN),X2=-90 D C^%DTC S YSKF90=(X-.001),^TMP("CHKDT",$J,YSKFDFN)=2_U_+^UTILITY($J,"FIRSTOP",YSKFDFN)_U_YSKF90 D
|
|
.. S NXTDT=YSKF90 F S NXTDT=$O(^TMP("XNNEW",$J,YSKFDFN,NXTDT)) Q:NXTDT'>0!(STOP=1) D ;back up to find previous entries
|
|
...I NXTDT=+^UTILITY($J,"FIRSTOP",YSKFDFN) S STOP=1 Q ;no previous entries
|
|
...S X1=NXTDT,X2=-90 D C^%DTC S YSKF90=(X-.001)
|
|
...I +^TMP("XNNEW",$J,YSKFDFN,NXTDT)=1 S STOP=1,^TMP("CHKDT",$J,YSKFDFN)=1_U_NXTDT_U_YSKF90
|
|
.S PT=+^TMP("CHKDT",$J,YSKFDFN)
|
|
.S YSKFDT=$P(^TMP("CHKDT",$J,YSKFDFN),"^",2),YSKF90=$P(^TMP("CHKDT",$J,YSKFDFN),"^",3)
|
|
. D NEW1 ;if ^tmp("x90",$j,YSKFdfn) not set, then new patient
|
|
.I '$D(^TMP("X90",$J,YSKFDFN)) S ^TMP("ASICHKDT",$J,YSKFDFN)=PT_U_YSKFDT_U_YSKF90
|
|
Q
|
|
;
|
|
NEW1 I '$D(^DGPT("B",YSKFDFN)) G NEW2
|
|
I '$D(^TMP("24STAY",$J,YSKFDFN)) G NEW2
|
|
S ADMT=YSKF90 F S ADMT=$O(^DGPT("AAD",YSKFDFN,ADMT)) Q:ADMT>YSKFDT!(ADMT'>0) S YSKFIEN=0 F S YSKFIEN=$O(^DGPT("AAD",YSKFDFN,ADMT,YSKFIEN)) Q:YSKFIEN="" D
|
|
.I $D(^DGPT(YSKFIEN,535,0)) S PHYSMV=0 F S PHYSMV=$O(^DGPT(YSKFIEN,535,PHYSMV)) Q:PHYSMV'>0 Q:'$D(^DGPT(YSKFIEN,535,PHYSMV,0)) I $D(WARD(+$P(^DGPT(YSKFIEN,535,PHYSMV,0),U,2))) D
|
|
..I ADMT'=YSKFDT S ^TMP("X90",$J,YSKFDFN,ADMT,1)=1_U_+$P(^DGPT(YSKFIEN,535,PHYSMV,0),U,2) ;PC 8/3/01
|
|
.I $D(^DGPT(YSKFIEN,"M",0)) S MOVE=0 F S MOVE=$O(^DGPT(YSKFIEN,"M",MOVE)) Q:MOVE'>0 Q:'$D(^DGPT(YSKFIEN,"M",MOVE,0)) I $D(WARD(+$P(^DGPT(YSKFIEN,"M",MOVE,0),U,2))) D
|
|
..I ADMT'=YSKFDT S ^TMP("X90",$J,YSKFDFN,ADMT,1)=1_U_+$P(^DGPT(YSKFIEN,"M",MOVE,0),U,2) ; PC 8/3/01 visit/stay in mental health
|
|
;
|
|
NEW2 ;find encounters in sub abuse clinics
|
|
I $D(^TMP("X90",$J,YSKFDFN)) Q
|
|
I ($G(^UTILITY($J,"OPT",YSKFDFN))<3)&('$D(^TMP("24STAY",$J,YSKFDFN))) S ^TMP("X90",$J,YSKFDFN,YSKFDT,2)=2 Q ;not 3 visits and no 24hr stay,then not new
|
|
;
|
|
S FND=0,YSKFECDT=YSKF90 F S YSKFECDT=$O(^SCE("ADFN",YSKFDFN,YSKFECDT)) Q:YSKFECDT=""!(FND=1)!(YSKFECDT>YSKFDT) S YSKFENC=0 F S YSKFENC=$O(^SCE("ADFN",YSKFDFN,YSKFECDT,YSKFENC)) Q:YSKFENC="" D
|
|
.Q:'$D(^SCE(YSKFENC,0))
|
|
.Q:$P(^SCE(YSKFENC,0),U,12)=8 Q:$P(^(0),U,12)=12 ;PC 6/28/01
|
|
.I $D(CLINIC(+$P(^SCE(YSKFENC,0),U,3))) D
|
|
..I YSKFECDT'=YSKFDT S ^TMP("X90",$J,YSKFDFN,YSKFECDT,YSKFENC)=2_U_+$P(^SCE(YSKFENC,0),U,3),FND=1 ;PC 8/3/01 visit/stay in mental health
|
|
Q
|
|
ASI ;determine if ASI done
|
|
S YSKFDFN=0 F S YSKFDFN=$O(^TMP("ASICHKDT",$J,YSKFDFN)) Q:YSKFDFN'>0 S YSKFDT=$P(^TMP("ASICHKDT",$J,YSKFDFN),"^",2),PT=+^TMP("ASICHKDT",$J,YSKFDFN) D
|
|
.I PT=1 D
|
|
..I '$D(^TMP("24STAY",$J,YSKFDFN)) Q
|
|
..S X1=YSKFDT,X2=14 D C^%DTC S CHKDT=X S:CHKDT>TODAY ^TMP("UNKASI",$J,YSKFDFN)="" I '$D(^TMP("XN",$J,"ASI",YSKFDFN)) S PT=1 D ASI0
|
|
.I PT=2 D
|
|
..I $D(^TMP("XN",$J,"ASI",YSKFDFN)) Q
|
|
..I ($D(^UTILITY($J,"TRDOP",YSKFDFN))) D
|
|
...S FIRSTDT=+$G(^UTILITY($J,"FIRSTOP",YSKFDFN)) S X1=+^UTILITY($J,"TRDOP",YSKFDFN) S X2=14 D C^%DTC S CHKDT=X
|
|
...S:CHKDT>TODAY ^TMP("UNKASI",$J,YSKFDFN)=""
|
|
..D ASI0 ;PC 8/3/01
|
|
.I PT=2&('$D(^UTILITY($J,"TRDOP",YSKFDFN)))&($D(^TMP("24STAY",$J,YSKFDFN))) D ;if not 3 visits but 24 hr stay, check ASI
|
|
..S ASI=0,INDATE=YSKFDT F S INDATE=$O(^TMP("XN",$J,YSKFDFN,INDATE)) Q:INDATE'>0!(ASI=1) S YSKFDT=INDATE D ;PC 8/3/01
|
|
...S X1=YSKFDT,X2=14 D C^%DTC S CHKDT=X
|
|
...S:CHKDT>TODAY ^TMP("UNKASI",$J,YSKFDFN)=""
|
|
...I '$D(^TMP("XN",$J,"ASI",YSKFDFN)) S PT=1 D ASI0
|
|
NOASI ;
|
|
S YSKFDFN=0 F S YSKFDFN=$O(^TMP("XN",$J,YSKFDFN)) Q:YSKFDFN'>0 I '$D(^TMP("XN",$J,"ASI",YSKFDFN)) S YSKFDT=0 F S YSKFDT=$O(^TMP("XN",$J,YSKFDFN,YSKFDT)) Q:YSKFDT'>0 D
|
|
.I $D(^TMP("UNKASI",$J,YSKFDFN)) S ^TMP("SHORT",$J,YSKFDFN)=^TMP("XN",$J,YSKFDFN,YSKFDT)_U_YSKFDT Q
|
|
.I YSKFDT<(TODAY_.9999) S ^TMP("XN1",$J,YSKFDFN,YSKFDT,1)=^TMP("XN",$J,YSKFDFN,YSKFDT)
|
|
S YSKFDFN=0 F S YSKFDFN=$O(^TMP("XNOPT",$J,YSKFDFN)) Q:YSKFDFN'>0 I '$D(^TMP("XN",$J,"ASI",YSKFDFN)) S YSKFDT=0 F S YSKFDT=$O(^TMP("XNOPT",$J,YSKFDFN,YSKFDT)) Q:YSKFDT'>0 S ENC=0 F S ENC=$O(^TMP("XNOPT",$J,YSKFDFN,YSKFDT,ENC)) Q:ENC'>0 D
|
|
.I $D(^TMP("UNKASI",$J,YSKFDFN)) S ^TMP("SHORT",$J,YSKFDFN)=^TMP("XNOPT",$J,YSKFDFN,YSKFDT,ENC)_U_YSKFDT_U_$G(^UTILITY($J,"TRDOP",YSKFDFN)) Q
|
|
.I YSKFDT<(TODAY_.9999) S ^TMP("XN1",$J,YSKFDFN,YSKFDT,ENC)=^TMP("XNOPT",$J,YSKFDFN,YSKFDT,ENC)
|
|
;
|
|
Q
|
|
ASI0 ;
|
|
S YSKFASI=0 F S YSKFASI=$O(^YSTX(604,"C",YSKFDFN,YSKFASI)) Q:YSKFASI'>0 D
|
|
.S YSKFSP=0
|
|
.;YSKFASDT=interview date, YSKFCLS=class, YSKFSP=special
|
|
.S YSKFASDT=$P($G(^YSTX(604,YSKFASI,0)),U,5)
|
|
.S TSTMONTH=+$E(YSKFASDT,4,5)
|
|
.I PT=1 D
|
|
..S X1=YSKFDT,X2=-30 D C^%DTC S CHKDT30=X
|
|
..I ((YSKFASDT>(CHKDT30-.001))&(YSKFASDT<(CHKDT+.999))) D
|
|
...S YSKFSP=$P($G(^YSTX(604,YSKFASI,0)),U,11) I YSKFSP=1!(YSKFSP=2)!(YSKFSP=3) D
|
|
....S YSKFSP=$S(YSKFSP=1:"Terminated",YSKFSP=2:"Refused",YSKFSP=3:"Unable to respond",1:"") ;pt terminated or refused
|
|
...S YSKFCLS=$P($G(^YSTX(604,YSKFASI,0)),U,4)
|
|
...S YSKFASD=$E(YSKFASDT,4,5)_"/"_$E(YSKFASDT,6,7)_"/"_$E(YSKFASDT,2,3)
|
|
...S ^TMP("XN",$J,"ASI",YSKFDFN)=PT_U_YSKFDT_U_YSKFCLS_U_YSKFSP_U_TSTMONTH_U_YSKFASD_U_YSKFASDT_U_$P(^TMP("XNNEW",$J,YSKFDFN,YSKFDT),"^",2) S ASI=1 Q
|
|
.; code change to look for ASI 30 days prior to first opt visit
|
|
.I PT=2 I $D(^UTILITY($J,"TRDOP",YSKFDFN)) D
|
|
..S X1=FIRSTDT,X2=-30 D C^%DTC S CHKDT30=X
|
|
..I ((YSKFASDT>(CHKDT30-.001))&(YSKFASDT<(CHKDT+.999))) D
|
|
...S YSKFSP=$P($G(^YSTX(604,YSKFASI,0)),U,11) I YSKFSP=1!(YSKFSP=2)!(YSKFSP=3) D
|
|
....S YSKFSP=$S(YSKFSP=1:"Terminated",YSKFSP=2:"Refused",YSKFSP=3:"Unable to respond",1:"") ;pt terminated or refused
|
|
...S YSKFCLS=$P($G(^YSTX(604,YSKFASI,0)),U,4)
|
|
...S YSKFASD=$E(YSKFASDT,4,5)_"/"_$E(YSKFASDT,6,7)_"/"_$E(YSKFASDT,2,3)
|
|
...S ^TMP("XN",$J,"ASI",YSKFDFN)=PT_U_YSKFDT_U_YSKFCLS_U_YSKFSP_U_TSTMONTH_U_YSKFASD_U_YSKFASDT_U_$P(^TMP("XNNEW",$J,YSKFDFN,YSKFDT),"^",2) S ASI=1 Q
|
|
;
|