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
 ;