source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSMTI6.m@ 810

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

initial load of FOIAVistA 6/30/08 version

File size: 1.8 KB
Line 
1YSMTI6 ;ALB/ASF-MULTIPLE PSYCH TESTS NEW ;4/18/01 17:27
2 ;;5.01;MENTAL HEALTH;**62,71**;Dec 30, 1994
3 Q
4AUDIT ;
5 N I,X,N,X1
6 S X=^YTD(601.2,YSDFN,1,YSET,1,YSED,1)
7 S R=0 F I=1:1:8 S R=R+$E(X,I)
8 S X1=$S($E(X,9)=1:2,$E(X,9)=2:4,1:0) S R=R+X1
9 S X1=$S($E(X,10)=1:2,$E(X,10)=2:4,1:0) S R=R+X1
10 Q
11DOMG ;
12 N I,X,YSMISS,YSDEP
13 S X=^YTD(601.2,YSDFN,1,YSET,1,YSED,1)
14 S (YSMISS,YSDEP)=0 F I=1:1:5 S YSDEP=YSDEP+$E(X,I) S:$E(X,I)="X" YSMISS=YSMISS+1
15 I YSMISS=1 S YSDEP=YSDEP+(YSDEP/4)
16 I YSMISS>1 S S="invalid"
17 S R=YSDEP
18 Q
19PAI ; ASF 4/18/01
20 N A,B,J,YSICN,YSKK,YSMX,YSNUMX,YSTL
21 S (R,S)="^",YSMX=4
22 D RD
23 Q:$L(X,"X")>18
24 D SCOR,STND
25 Q ;--> OUT
26RD S X=^YTD(601.2,YSDFN,1,YSET,1,YSED,1)_^YTD(601.2,YSDFN,1,YSET,1,YSED,2) Q
27SCOR ;
28 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
29FS ;full scales
30 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)
31ICNR ;score ICN
32 S YSICN=0
33 S Y=(5-$E(X,75))-(5-$E(X,115)) D A
34 S Y=$E(X,4)-$E(X,44) D A
35 S Y=$E(X,60)-$E(X,100) D A
36 S Y=$E(X,145)-(5-$E(X,185)) D A
37 S Y=$E(X,65)-(5-$E(X,246)) D A
38 S Y=$E(X,102)-(5-$E(X,103)) D A
39 S Y=$E(X,22)-(5-$E(X,142)) D A
40 S Y=(5-$E(X,301))-$E(X,140) D A
41 S Y=5-(5-$E(X,270))-$E(X,53) D A
42 S Y=5-(5-$E(X,190))-$E(X,13) D A
43 S $P(R,U,1)=YSICN
44 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)
45 Q
46A ;icn absolutes
47 S:Y<0 Y=-Y S YSICN=YSICN+Y Q
48KK S YSNUMX=0
49 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
50 I (YSNUMX/(I-1))>.2 S YSTL="X"
51 Q
52STND ;stanard T scores
53 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
54 Q
Note: See TracBrowser for help on using the repository browser.