[613] | 1 | YTPAI ;ASF/ALB- PAI TEST ;7/14/00 10:26
|
---|
| 2 | ;;5.01;MENTAL HEALTH;**10,66**;Dec 30, 1994
|
---|
| 3 | ;
|
---|
| 4 | ;Reference to $$SQRT^XLFMTH supported by IA #10105
|
---|
| 5 | ;
|
---|
| 6 | S YSLFT=0,YSNOITEM="DONE^YTPAI"
|
---|
| 7 | MAIN ;
|
---|
| 8 | S (R,S)="^",YSMX=4
|
---|
| 9 | D RD
|
---|
| 10 | I $L(X,"X")>18 D DTA^YTREPT W !!!!,"PAI: Too many missing items to score" D:IOST?1"C".E SCR^YTREPT G OUT
|
---|
| 11 | D SCOR,STND
|
---|
| 12 | D ^YTPAI1 ;profile
|
---|
| 13 | G DONE:YSLFT D:IOST?1"C-".E SCR^YTREPT
|
---|
| 14 | D SUBS^YTPAI1
|
---|
| 15 | G DONE:YSLFT D:IOST?1"C-".E SCR^YTREPT
|
---|
| 16 | D ADDIT
|
---|
| 17 | D FIT
|
---|
| 18 | G DONE:YSLFT D:IOST?1"C-".E SCR^YTREPT
|
---|
| 19 | D CRIT ;critical items
|
---|
| 20 | G DONE:YSLFT D:IOST?1"C-".E SCR^YTREPT
|
---|
| 21 | OUT D DTA^YTREPT,IR^YTPAI1
|
---|
| 22 | DONE K S,R,A,YSXBAR,YSYBAR,YSXSD,YSYSD Q
|
---|
| 23 | RD S X=^YTD(601.2,YSDFN,1,YSET,1,YSED,1)_^YTD(601.2,YSDFN,1,YSET,1,YSED,2) Q
|
---|
| 24 | SCOR ;
|
---|
| 25 | F YSKK=2:1:53 I $D(^YTT(601,YSTEST,"S",YSKK,"K")) S Y=^YTT(601,YSTEST,"S",YSKK,"K",1,0),YSTL=0 D KK S $P(R,U,YSKK)=YSTL
|
---|
| 26 | FS ;full scales
|
---|
| 27 | F I=5,9,13,17,21,25,29,33,38,44 S $P(R,U,I)=$P(R,U,I+1)+$P(R,U,I+2)+$P(R,U,I+3) S:I=33 $P(R,U,I)=$P(R,U,I)+$P(R,U,I+4)
|
---|
| 28 | ICNR ;score ICN
|
---|
| 29 | S YSICN=0
|
---|
| 30 | S Y=(5-$E(X,75))-(5-$E(X,115)) D A
|
---|
| 31 | S Y=$E(X,4)-$E(X,44) D A
|
---|
| 32 | S Y=$E(X,60)-$E(X,100) D A
|
---|
| 33 | S Y=$E(X,145)-(5-$E(X,185)) D A
|
---|
| 34 | S Y=$E(X,65)-(5-$E(X,246)) D A
|
---|
| 35 | S Y=$E(X,102)-(5-$E(X,103)) D A
|
---|
| 36 | S Y=$E(X,22)-(5-$E(X,142)) D A
|
---|
| 37 | S Y=(5-$E(X,301))-$E(X,140) D A
|
---|
| 38 | S Y=5-(5-$E(X,270))-$E(X,53) D A
|
---|
| 39 | S Y=5-(5-$E(X,190))-$E(X,13) D A
|
---|
| 40 | S $P(R,U,1)=YSICN
|
---|
| 41 | S X=^YTT(601,YSTEST,"S",1,"M"),$P(S,U,1)=$J((YSICN-$P(X,U)/$P(X,U,2)*10+50),0,0)
|
---|
| 42 | Q
|
---|
| 43 | A ;icn absolutes
|
---|
| 44 | S:Y<0 Y=-Y S YSICN=YSICN+Y Q
|
---|
| 45 | KK S YSNUMX=0
|
---|
| 46 | F I=1:2 Q:$P(Y,U,I)="" S YSIT=$P(Y,U,I),A=$P(Y,U,I+1),B=$E(X,YSIT),YSTL=YSTL+$S(B="X":0,A="D":B-1,1:YSMX-B) S:B="X" YSNUMX=YSNUMX+1
|
---|
| 47 | I (YSNUMX/(I-1))>.2 S YSTL="X"
|
---|
| 48 | Q
|
---|
| 49 | STND ;stanard T scores
|
---|
| 50 | F J=2:1:53 S A=$P(R,U,J) S:A?.N X=^YTT(601,YSTEST,"S",J,"M"),S(J)=$J((A-$P(X,U)/$P(X,U,2)*10+50),0,0) S:A="X" S(J)="X" S S=S_S(J)_U
|
---|
| 51 | Q
|
---|
| 52 | ADDIT ;additional indexes
|
---|
| 53 | D DTA^YTREPT
|
---|
| 54 | S YSINDX=0
|
---|
| 55 | I $P(S,U,3)>109 S YSINDX=YSINDX+1
|
---|
| 56 | I $P(S,U,3)-$P(S,U,2)>19 S YSINDX=YSINDX+1
|
---|
| 57 | I $P(S,U,2)-$P(S,U,1)>14 S YSINDX=YSINDX+1 ;asf 7/14/00 =YSINDX+2
|
---|
| 58 | I $P(S,U,27)-$P(S,U,26)>14 S YSINDX=YSINDX+1
|
---|
| 59 | I $P(S,U,27)-$P(S,U,28)>14 S YSINDX=YSINDX+1
|
---|
| 60 | I $P(S,U,24)-$P(S,U,23)>14 S YSINDX=YSINDX+1
|
---|
| 61 | I ($P(S,U,17)>84)&($P(S,U,51)>44) S YSINDX=YSINDX+1
|
---|
| 62 | I $P(S,U,40)-$P(S,U,39)>9 S YSINDX=YSINDX+1
|
---|
| 63 | W !?2,"Malingering Index = ",YSINDX
|
---|
| 64 | S YSINDX=0 ; RESET
|
---|
| 65 | I $P(S,U,4)>44 S YSINDX=YSINDX+1 S:$P(S,U,4)>49 YSINDX=YSINDX+1
|
---|
| 66 | I $P(S,U,51)>44 S YSINDX=YSINDX+1
|
---|
| 67 | I $P(S,U,40)-$P(S,U,39)>9 S YSINDX=YSINDX+1
|
---|
| 68 | I $P(S,U,41)-$P(S,U,39)>9 S YSINDX=YSINDX+1
|
---|
| 69 | I $P(S,U,23)-$P(S,U,24)>9 S YSINDX=YSINDX+1
|
---|
| 70 | I $P(S,U,14)-$P(S,U,11)>9 S YSINDX=YSINDX+1
|
---|
| 71 | I $P(S,U,52)-$P(S,U,46)>14 S YSINDX=YSINDX+1
|
---|
| 72 | I $P(S,U,22)-$P(S,U,49)>9 S YSINDX=YSINDX+1
|
---|
| 73 | W !?2,"Defensivness Index = ",$J(YSINDX,3)
|
---|
| 74 | XBAR ;
|
---|
| 75 | S YSINDX=0 F I=5,9,13,17,21,25,29,33,38,42,43 S YSINDX=YSINDX+$P(S,U,I)
|
---|
| 76 | W !?2,"Mean Clinical Elevation = ",$J(YSINDX/11,4,0)
|
---|
| 77 | Q
|
---|
| 78 | FIT ;coeff of fit
|
---|
| 79 | W !!,"Database Profile",?30,"Coefficient of Fit"
|
---|
| 80 | K A F K=1:1:41 D FIT1
|
---|
| 81 | S N=0 F S N=$O(A(N)) Q:N'>0 S K=0 F S K=$O(A(N,K)) Q:K'>0 G DONE:YSLFT D:IOST?1"C-".E&($Y+4>IOSL) SCR^YTREPT D FITW
|
---|
| 82 | Q
|
---|
| 83 | FITW W !,$P(^YTT(601,YSTEST,"G",1,1,K,0),U,1),?35,$J(9-N,6,3)
|
---|
| 84 | Q
|
---|
| 85 | FIT1 S (X1,Y1,X12,Y12,YSXY)=0,N=1
|
---|
| 86 | S YSFIT=^YTT(601,YSTEST,"G",1,1,K,0)
|
---|
| 87 | F I=1,2,3,4,5,9,13,17,21,25,29,33,38,42,43,44,48:1:53 D FITLOOP
|
---|
| 88 | ;stanadrd dev t scores
|
---|
| 89 | S YSXBAR=X1/22
|
---|
| 90 | S YSXSD=$$SQRT^XLFMTH(X12/22-(YSXBAR*YSXBAR))
|
---|
| 91 | ;standard dev fit data
|
---|
| 92 | S YSYBAR=Y1/22
|
---|
| 93 | S YSYSD=$$SQRT^XLFMTH(Y12/22-(YSYBAR*YSYBAR))
|
---|
| 94 | ; CORR
|
---|
| 95 | S YSR=((YSXY/22)-(YSXBAR*YSYBAR))/(YSXSD*YSYSD)
|
---|
| 96 | S A(9-YSR,K)=""
|
---|
| 97 | Q
|
---|
| 98 | FITLOOP ;get individual items
|
---|
| 99 | S N=N+1,X1=X1+$P(S,U,I),X12=X12+($P(S,U,I)*$P(S,U,I)),Y1=Y1+$P(YSFIT,U,N),Y12=Y12+($P(YSFIT,U,N)*$P(YSFIT,U,N)),YSXY=YSXY+($P(S,U,I)*$P(YSFIT,U,N))
|
---|
| 100 | Q
|
---|
| 101 | CRIT ;
|
---|
| 102 | D RD,DTA^YTREPT
|
---|
| 103 | W !?10,"Critical Items",!!,"Delusions and Hallucinations"
|
---|
| 104 | F I=90,130,170,210,309 D CRITW
|
---|
| 105 | W !!,"Potential for Self-Harm" F I=100,183,206,220,340 D CRITW
|
---|
| 106 | W !!,"Potential for Aggression" F I=21,61,101,181 D CRITW
|
---|
| 107 | W !!,"Substance Abuse" F I=55,222 D CRITW
|
---|
| 108 | W !!,"Potential Malingering" F I=9,49,129,249 D CRITW
|
---|
| 109 | W !!,"Ureliability/Resistance" F I=31,71,311 D CRITW
|
---|
| 110 | W !!,"Traumatic Stressors" F I=34,114,194,274 D CRITW
|
---|
| 111 | Q
|
---|
| 112 | CRITW ; write critical items
|
---|
| 113 | Q:$E(X,I)<2
|
---|
| 114 | W !,$S($E(X,I)=2:"ST",$E(X,I)=3:"MT",1:"VT")," "
|
---|
| 115 | W ^YTT(601,YSTEST,"Q",I,"T",1,0)
|
---|
| 116 | W:$D(^YTT(601,YSTEST,"Q",I,"T",2,0)) !?7,^YTT(601,YSTEST,"Q",I,"T",2,0)
|
---|
| 117 | Q
|
---|