96 lines
3.2 KiB
Mathematica
96 lines
3.2 KiB
Mathematica
YTSCL9R ;ALB/ASF-SCL90 R SCORING ;1/5/96 09:02
|
|
;;5.01;MENTAL HEALTH;**10**;Dec 30, 1994
|
|
MAIN ;
|
|
D RD
|
|
D VALIDITY Q:YSVFLAG
|
|
D SS
|
|
D GSI,PST,PSDI
|
|
D TSCORE
|
|
D ^YTSCL9R1 ;graphit
|
|
D BOTTOM^YTSCL9R1 ;graph legend
|
|
D REPT
|
|
D:IOST?1"C-".E SCR^YTREPT Q:YSTOUT!YSUOUT
|
|
D NOTE^YTSCL9R1 ;symptoms of note
|
|
D END
|
|
Q
|
|
RD S X=^YTD(601.2,YSDFN,1,YSTEST,1,YSED,1)
|
|
Q
|
|
SS ;symtom scales
|
|
S (R,S,S(1),S(2),S(3),YSTOTAL)=""
|
|
F YSI=1:1:10 D SS1
|
|
Q
|
|
SS1 ;
|
|
S YSK=^YTT(601,YSTEST,"S",YSI,"K",1,0)
|
|
S YSDIV=0,YSMIS=0
|
|
F J=1:2 S YSITEM=$P(YSK,U,J) Q:YSITEM="" S:$E(X,YSITEM)="X" YSMIS=YSMIS+1 S:$E(X,YSITEM)'="X" YSDIV=YSDIV+1,$P(R,U,YSI)=$P(R,U,YSI)+$E(X,YSITEM),YSTOTAL=YSTOTAL+$E(X,YSITEM)
|
|
;divide by number of non omitted in scale
|
|
S:YSDIV>0 $P(R,U,YSI)=$J($P(R,U,YSI)/YSDIV,0,2)
|
|
;set tscore to 0 if more than 40% ommitted
|
|
I YSMIS/(YSMIS+YSDIV)>.4 S $P(S(1),U,YSI)=0,$P(S(2),U,YSI)=0,$P(S(3),U,YSI)=0
|
|
Q
|
|
GSI ;global severity index
|
|
S $P(R,U,11)=$J(YSTOTAL/(90-($L(X,"X")-1)),0,2)
|
|
Q
|
|
PST ;positive symptom total
|
|
S $P(R,U,13)=($L(X,4)-1)+($L(X,3)-1)+($L(X,2)-1)+($L(X,1)-1)
|
|
Q
|
|
PSDI ;positive symptom distress index
|
|
S $P(R,U,12)=$J(YSTOTAL/$P(R,U,13),0,2)
|
|
Q
|
|
VALIDITY ;
|
|
S YSVFLAG=0
|
|
I $L(X,"X")>19 W !!,"Administration invalid: More than 18 items were ommitted",!! S YSVFLAG=1 Q
|
|
I YSAGE<18 W !!,"Norms for this age group not available",!! S YSVFLAG=1 Q
|
|
I $L(X,4)=91!($L(X,3)=91)!($L(X,2)=91)!($L(X,1)=91)!($L(X,0)=91) W !!,"Adminisration invalid: all questions were answered the same",!! S YSVFLAG=1 Q
|
|
Q
|
|
TSCORE ; 1=outpatient, 2=nonpatients, 3= inpatients
|
|
F YSNORM=1,2,3 D TS1,TPST,EXTREME
|
|
Q
|
|
TS1 F YSI=1:1:9,11,12 D LKUP
|
|
Q
|
|
LKUP ;
|
|
S YSRAW=+$P(R,U,YSI)
|
|
S N=0 F S N=$O(^YTT(601,YSTEST,YSSEX,YSNORM,1,N)) Q:N'>0 S YSROW=^(N,0),YSVALUE=+YSROW I YSVALUE=YSRAW!(YSVALUE>YSRAW) D LKUP1 Q
|
|
Q
|
|
LKUP1 ;
|
|
Q:$P(S(YSNORM),U,YSI)=0 ;already taged invalid
|
|
S YSLKP=$S(YSI>9:YSI-1,1:YSI)
|
|
S YSTNOW=$P(YSROW,U,YSLKP+1)
|
|
Q:'+YSTNOW ;its an extreme
|
|
I +YSVALUE=+$P(R,U,YSI) S $P(S(YSNORM),U,YSI)=YSTNOW Q
|
|
IF YSRAW<YSVALUE D:N>1 TRANS
|
|
Q
|
|
TRANS ;
|
|
Q:N=1
|
|
S YSROWP=^YTT(601,YSTEST,YSSEX,YSNORM,1,N-1,0)
|
|
S YSVOLD=+YSROWP,YSTOLD=$P(YSROWP,U,YSLKP+1)
|
|
Q:'+YSTOLD ;its an extreme
|
|
S YST=((YSTNOW-YSTOLD)/(YSVALUE-YSVOLD))*(YSRAW-YSVOLD)+YSTOLD
|
|
S $P(S(YSNORM),U,YSI)=$J(YST,0,0)
|
|
Q
|
|
TPST ; tscores for pst
|
|
S YSROW=^YTT(601,YSTEST,YSSEX,4,1,$P(R,U,13),0)
|
|
S $P(S(YSNORM),U,13)=$P(YSROW,U,YSNORM+1)
|
|
Q
|
|
EXTREME ;
|
|
F YSI=1:1:9,11,12 D EX1
|
|
Q
|
|
EX1 ;
|
|
Q:$P(S(YSNORM),U,YSI)'=""
|
|
S YSRAW=$P(R,U,YSI),X=$S(YSRAW>1.2:2,1:1)
|
|
S $P(S(YSNORM),U,YSI)=$P(^YTT(601,YSTEST,YSSEX,YSNORM+4,1,X,0),U,YSI)
|
|
Q
|
|
REPT ;
|
|
S X=$P(^YTT(601,YSTEST,"P"),U),A=$P(^("P"),U,2),B=$P(^("P"),U,3),L1=58-A\2,L2=L1+A+4 S:A<9 A=9
|
|
D DTA^YTREPT W !!?(72-$L(X)\2),X,!!!?3,"S C A L E",?37,"RAW Outpatients Nonpatients Inpatients"
|
|
F YSI=1:1:9,11,12,13 D REPT1
|
|
Q
|
|
REPT1 ;
|
|
S YSRS=$P(R,U,YSI),S1=$P(S(1),U,YSI),S2=$P(S(2),U,YSI),S3=$P(S(3),U,YSI)
|
|
D:IOST?1"C-".E&($Y>21) SCR^YTREPT Q:YSTOUT!YSUOUT
|
|
W !?3,$P($P(^YTT(601,YSTEST,"S",YSI,0),U,2),";",2),?37,$S(YSI=13:$J(YSRS,4,0),1:$J(YSRS,4,2)),$J(S1,8,0),$J(S2,13,0),$J(S3,13,0)
|
|
W:YSI=9 !!
|
|
Q
|
|
END K L1,L2,N,R,S,X,S1,S2,S3,YSDIV,YSI,YSITEM,YSK,YSLKP,YSLV,YSMIS,YSNORM,YSNS,YSRAW,YSROW,YSROWP,YSRS,YST,YSTNOW,YSTOLD,YSTOTAL,YSVALUE,YSVFLAG,YSVOLD
|
|
Q
|