70 lines
4.1 KiB
Mathematica
70 lines
4.1 KiB
Mathematica
YSKFASIF ;16IT/PTC - SUBSTANCE ABUSE FOLLOWUP ;6/28/01 14:31
|
|
;;5.01;MENTAL HEALTH;**73**;Dec 30, 1994
|
|
;
|
|
;Reference to ^DPT( supported by DBIA #10035
|
|
;
|
|
START D NOW^%DTC S TODAY=X
|
|
;
|
|
S (FOLLCT,YSKFDFN)=0 F S YSKFDFN=$O(^TMP("FOLLUP",$J,YSKFDFN)) Q:YSKFDFN="" S FOLLCT=FOLLCT+1,NXT=$P(^TMP("FOLLUP",$J,YSKFDFN),"^"),NXT2=$P(^TMP("FOLLUP",$J,YSKFDFN),"^",2) D
|
|
.S ASIDT=$P(^TMP("FOLLUP",$J,YSKFDFN),"^",3)
|
|
.;GET START DATE FROM NXT AND END DATE FROM NXT2
|
|
.S:$L(NXT)<2 NXT="0"_NXT S:$L(NXT2)<2 NXT2="0"_NXT2
|
|
.I $E(ASIDT,4,5)<8 S NXTDT=$E(ASIDT,1,3)_NXT_"01"
|
|
.I $E(ASIDT,4,5)>7 S NXTDT=($E(ASIDT,1,3)+1)_NXT_"01"
|
|
.I NXT<11 S NXT2DT=$E(NXTDT,1,3)_NXT2
|
|
.I NXT>10 S NXT2DT=($E(NXTDT,1,3)+1)_NXT2
|
|
.S X=+NXT2,X=$S("^1^3^5^7^8^10^12^"[(U_X_U):31,X'=2:30,$E(NXT2DT,1,3)#4:28,1:29) S NXT2DT=NXT2DT_X
|
|
.S $P(^TMP("FOLLUP",$J,YSKFDFN),"^",6)=NXTDT
|
|
.S $P(^TMP("FOLLUP",$J,YSKFDFN),"^",7)=NXT2DT
|
|
.D ASI0
|
|
;
|
|
NOASI ;
|
|
S (FOLLG12,FOLLDONE,FOLLSHR,NOFOLLCT,YSKFDFN)=0 F S YSKFDFN=$O(^TMP("FOLLUP",$J,YSKFDFN)) Q:YSKFDFN="" D ;ASF/6/15/01
|
|
.I '$D(^TMP("FOLLASI",$J,YSKFDFN)) S NXTDT=$P(^TMP("FOLLUP",$J,YSKFDFN),"^",6),NXT2DT=$P(^(YSKFDFN),"^",7) D
|
|
..I TODAY<NXTDT!(TODAY<NXT2DT) S ^UTILITY($J,"EARLY",YSKFDFN)=^TMP("FOLLUP",$J,YSKFDFN),FOLLSHR=FOLLSHR+1 S SHORT=1 D ALPHA Q
|
|
..S NOFOLLCT=NOFOLLCT+1 S SHORT=0 D ALPHA
|
|
.I $D(^TMP("FOLLASI",$J,YSKFDFN))&($P($G(TMP("FOLLASI",$J,YSKFDFN)),U,2)="N") S FOLLDONE=FOLLDONE+1 ;ASF 6/15/01
|
|
.I $D(^TMP("FOLLASI",$J,YSKFDFN))&($P($G(TMP("FOLLASI",$J,YSKFDFN)),U,2)?1N) S FOLLG12=FOLLG12+1 ;ASF 6/15/01
|
|
;
|
|
CALC ;
|
|
S FOLLSHRP=$S(FOLLCT'=0:((FOLLSHR/FOLLCT)*100),1:" .") ;EARLY
|
|
S FOLLDONP=$S(FOLLCT'=0:((FOLLDONE/FOLLCT)*100),1:" .") ;DONE
|
|
S FOLLG12P=$S(FOLLCT'=0:((FOLLG12/FOLLCT)*100),1:" .") ;DONE BUT G12 ASF 6/15/01
|
|
S NOFOLLP=$S(FOLLCT'=0:((NOFOLLCT/FOLLCT)*100),1:" .") ;NOT DONE
|
|
;
|
|
LIST ; patient w/o FOLLUP ASI
|
|
S YSKFJCNT=YSKFJCNT+1,^TMP("XM",$J,YSKFJCNT)=" PATIENTS WITHOUT FOLLOWUP ASI"
|
|
S YSKFJCNT=YSKFJCNT+1,^TMP("XM",$J,YSKFJCNT)="==============================================================================="
|
|
I $D(^TMP("PTNOFOLL",$J)) S MON="" F S MON=$O(^TMP("PTNOFOLL",$J,MON)) Q:MON="" S NAME="" F S NAME=$O(^TMP("PTNOFOLL",$J,MON,NAME)) Q:NAME="" S YSKFDFN=0 F S YSKFDFN=$O(^TMP("PTNOFOLL",$J,MON,NAME,YSKFDFN)) Q:YSKFDFN'>0 D
|
|
.S NODE=^TMP("PTNOFOLL",$J,MON,NAME,YSKFDFN) F I=1:1:4 S P(I)=$P(NODE,U,I)
|
|
.S YSKFJCNT=YSKFJCNT+1,^TMP("XM",$J,YSKFJCNT)=" "_P(1)_P(2)_" DUE: "_P(3)_" - "_P(4)
|
|
S YSKFJCNT=YSKFJCNT+1,^TMP("XM",$J,YSKFJCNT)=""
|
|
S YSKFJCNT=YSKFJCNT+1,^TMP("XM",$J,YSKFJCNT)=" PATIENTS WITHOUT FOLLOWUP ASI; TIME NOT EXPIRED"
|
|
S YSKFJCNT=YSKFJCNT+1,^TMP("XM",$J,YSKFJCNT)="==============================================================================="
|
|
I $D(^TMP("SHORTFOLL",$J)) S MON="" F S MON=$O(^TMP("SHORTFOLL",$J,MON)) Q:MON="" S NAME="" F S NAME=$O(^TMP("SHORTFOLL",$J,MON,NAME)) Q:NAME="" S YSKFDFN=0 F S YSKFDFN=$O(^TMP("SHORTFOLL",$J,MON,NAME,YSKFDFN)) Q:YSKFDFN="" D
|
|
.S NODE=^TMP("SHORTFOLL",$J,MON,NAME,YSKFDFN) F I=1:1:4 S P(I)=$P(NODE,U,I)
|
|
.S YSKFJCNT=YSKFJCNT+1,^TMP("XM",$J,YSKFJCNT)=" "_P(1)_P(2)_" DUE: "_P(3)_" - "_P(4)
|
|
S YSKFJCNT=YSKFJCNT+1,^TMP("XM",$J,YSKFJCNT)=""
|
|
Q
|
|
ASI0 ;
|
|
S (ASIF,YSKFASI)=0 F S YSKFASI=$O(^YSTX(604,"C",YSKFDFN,YSKFASI)) Q:YSKFASI'>0!(ASIF=1) D
|
|
.S YSKFSP=0
|
|
.;YSKFASDT=interview date, YSKFCLS=class, YSKFSP=special
|
|
.S YSKFSP=$P($G(^YSTX(604,YSKFASI,0)),U,11) ;ASF 6/28/01
|
|
.S YSKFASDT=$P($G(^YSTX(604,YSKFASI,0)),U,5)
|
|
.I ((YSKFASDT>(NXTDT-.001))&(YSKFASDT<(NXT2DT+.999))) D
|
|
..S YSKFASDT=$E(YSKFASDT,4,5)_"/"_$E(YSKFASDT,6,7)_"/"_$E(YSKFASDT,2,3)
|
|
..S ^TMP("FOLLASI",$J,YSKFDFN)=YSKFASDT_U_YSKFSP,ASIF=1 Q ;ASF 6/15/01
|
|
Q
|
|
ALPHA ;
|
|
S NAME=$P(^DPT(YSKFDFN,0),U,1),SSN=$P(^(0),U,9)
|
|
S PRTNAME=NAME S YSKFL=$L(PRTNAME),YSKFLM=25-YSKFL F YSKFLCNT=1:1:YSKFLM S PRTNAME=PRTNAME_" "
|
|
S DAY1=$P(^TMP("FOLLUP",$J,YSKFDFN),"^",1),DAY1MON=$$DATE(DAY1)
|
|
S DAY2=$P(^TMP("FOLLUP",$J,YSKFDFN),"^",2),DAY2MON=$$DATE(DAY2)
|
|
I SHORT=0 S ^TMP("PTNOFOLL",$J,DAY1,NAME,YSKFDFN)=PRTNAME_U_SSN_U_DAY1MON_U_DAY2MON
|
|
I SHORT=1 S ^TMP("SHORTFOLL",$J,DAY1,NAME,YSKFDFN)=PRTNAME_U_SSN_U_DAY1MON_U_DAY2MON
|
|
Q
|
|
DATE(X) ;
|
|
S X=$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",+X)
|
|
Q X
|