source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTSCL9R.m@ 1800

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

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1YTSCL9R ;ALB/ASF-SCL90 R SCORING ;1/5/96 09:02
2 ;;5.01;MENTAL HEALTH;**10**;Dec 30, 1994
3MAIN ;
4 D RD
5 D VALIDITY Q:YSVFLAG
6 D SS
7 D GSI,PST,PSDI
8 D TSCORE
9 D ^YTSCL9R1 ;graphit
10 D BOTTOM^YTSCL9R1 ;graph legend
11 D REPT
12 D:IOST?1"C-".E SCR^YTREPT Q:YSTOUT!YSUOUT
13 D NOTE^YTSCL9R1 ;symptoms of note
14 D END
15 Q
16RD S X=^YTD(601.2,YSDFN,1,YSTEST,1,YSED,1)
17 Q
18SS ;symtom scales
19 S (R,S,S(1),S(2),S(3),YSTOTAL)=""
20 F YSI=1:1:10 D SS1
21 Q
22SS1 ;
23 S YSK=^YTT(601,YSTEST,"S",YSI,"K",1,0)
24 S YSDIV=0,YSMIS=0
25 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)
26 ;divide by number of non omitted in scale
27 S:YSDIV>0 $P(R,U,YSI)=$J($P(R,U,YSI)/YSDIV,0,2)
28 ;set tscore to 0 if more than 40% ommitted
29 I YSMIS/(YSMIS+YSDIV)>.4 S $P(S(1),U,YSI)=0,$P(S(2),U,YSI)=0,$P(S(3),U,YSI)=0
30 Q
31GSI ;global severity index
32 S $P(R,U,11)=$J(YSTOTAL/(90-($L(X,"X")-1)),0,2)
33 Q
34PST ;positive symptom total
35 S $P(R,U,13)=($L(X,4)-1)+($L(X,3)-1)+($L(X,2)-1)+($L(X,1)-1)
36 Q
37PSDI ;positive symptom distress index
38 S $P(R,U,12)=$J(YSTOTAL/$P(R,U,13),0,2)
39 Q
40VALIDITY ;
41 S YSVFLAG=0
42 I $L(X,"X")>19 W !!,"Administration invalid: More than 18 items were ommitted",!! S YSVFLAG=1 Q
43 I YSAGE<18 W !!,"Norms for this age group not available",!! S YSVFLAG=1 Q
44 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
45 Q
46TSCORE ; 1=outpatient, 2=nonpatients, 3= inpatients
47 F YSNORM=1,2,3 D TS1,TPST,EXTREME
48 Q
49TS1 F YSI=1:1:9,11,12 D LKUP
50 Q
51LKUP ;
52 S YSRAW=+$P(R,U,YSI)
53 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
54 Q
55LKUP1 ;
56 Q:$P(S(YSNORM),U,YSI)=0 ;already taged invalid
57 S YSLKP=$S(YSI>9:YSI-1,1:YSI)
58 S YSTNOW=$P(YSROW,U,YSLKP+1)
59 Q:'+YSTNOW ;its an extreme
60 I +YSVALUE=+$P(R,U,YSI) S $P(S(YSNORM),U,YSI)=YSTNOW Q
61 IF YSRAW<YSVALUE D:N>1 TRANS
62 Q
63TRANS ;
64 Q:N=1
65 S YSROWP=^YTT(601,YSTEST,YSSEX,YSNORM,1,N-1,0)
66 S YSVOLD=+YSROWP,YSTOLD=$P(YSROWP,U,YSLKP+1)
67 Q:'+YSTOLD ;its an extreme
68 S YST=((YSTNOW-YSTOLD)/(YSVALUE-YSVOLD))*(YSRAW-YSVOLD)+YSTOLD
69 S $P(S(YSNORM),U,YSI)=$J(YST,0,0)
70 Q
71TPST ; tscores for pst
72 S YSROW=^YTT(601,YSTEST,YSSEX,4,1,$P(R,U,13),0)
73 S $P(S(YSNORM),U,13)=$P(YSROW,U,YSNORM+1)
74 Q
75EXTREME ;
76 F YSI=1:1:9,11,12 D EX1
77 Q
78EX1 ;
79 Q:$P(S(YSNORM),U,YSI)'=""
80 S YSRAW=$P(R,U,YSI),X=$S(YSRAW>1.2:2,1:1)
81 S $P(S(YSNORM),U,YSI)=$P(^YTT(601,YSTEST,YSSEX,YSNORM+4,1,X,0),U,YSI)
82 Q
83REPT ;
84 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
85 D DTA^YTREPT W !!?(72-$L(X)\2),X,!!!?3,"S C A L E",?37,"RAW Outpatients Nonpatients Inpatients"
86 F YSI=1:1:9,11,12,13 D REPT1
87 Q
88REPT1 ;
89 S YSRS=$P(R,U,YSI),S1=$P(S(1),U,YSI),S2=$P(S(2),U,YSI),S3=$P(S(3),U,YSI)
90 D:IOST?1"C-".E&($Y>21) SCR^YTREPT Q:YSTOUT!YSUOUT
91 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)
92 W:YSI=9 !!
93 Q
94END 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
95 Q
Note: See TracBrowser for help on using the repository browser.