45 lines
3.9 KiB
Mathematica
45 lines
3.9 KiB
Mathematica
YSMTI4 ;ALB/ASF PSYCH TEST DOWNLOAD MCMI2 ;7/23/99 09:42
|
|
;;5.01;MENTAL HEALTH;**53**;Dec 30, 1994
|
|
D DEM^VADPT S YSSEX=$P(VADM(5),U) K VADM
|
|
F0 S R="",J=1
|
|
T0 S L=200,M=0,YSKK=1,YSTL=0 G:J=27 STND D RD
|
|
T1 I '$D(^YTT(601,YSTEST,"S",J,"K",YSKK,0)) S R=R_YSTL_"^",J=J+1 G T0
|
|
S Y=^YTT(601,YSTEST,"S",J,"K",YSKK,0),P=1
|
|
T2 S YSIT=$P(Y,"^",P) I YSIT="" S YSKK=YSKK+1 G T1
|
|
S A=$P(Y,"^",P+1),P=P+2
|
|
S:$E(X,+YSIT-M)=A YSTL=YSTL+(+$P(YSIT,"(",2)) G T2
|
|
RD S X=^YTD(601.2,YSDFN,1,YSET,1,YSED,L\200) Q
|
|
STND S X=($P(R,U,7)*1.5)+($P(R,U,12)*1.5)+($P(R,U,4)*1.6)+($P(R,U,5)*1.6)+($P(R,U,6)*1.6)+($P(R,U,13)*1.6)+$P(R,U,8)+$P(R,U,9)+$P(R,U,10)+$P(R,U,11),X=$J(X,3,0)
|
|
S Y=^YTT(601,201,"S",1,YSSEX) F I=1:1 I X'>(+$P(Y,U,I)) S S=$P($P(Y,U,I),",",2) Q
|
|
S S=S_"^",$P(R,U,1)=X F J=2:1:25 S X=^YTT(601,YSTEST,"S",J,YSSX),A=$P(R,U,J),S1=$P(X,U,A+1) S:S1="" S1=$P(X,U,$L(X,U)) S S=S_S1_U
|
|
DC ;DIS C
|
|
S X=+R I X<145!(X>590)!((X>249)&(X<401)) G HDAA
|
|
I X>144,X<250 S YSCF=250-X\10 S:250-X/10#1 YSCF=YSCF+1 F I=4:1:25 S YSCF1=$S(I=14:.5,I=15:.5,I=16:.5,I=23:.5,I=24:.5,I=25:.5,1:1),$P(S,U,I)=$P(S,U,I)+(YSCF*YSCF1\1)
|
|
I X>400,X<591 S YSCF=X-400\16 S:X-400/16#1 YSCF=YSCF+1 F I=4:1:25 S YSCF1=$S(I=14:.5,I=15:.5,I=16:.5,I=23:.5,I=24:.5,I=25:.5,1:1),$P(S,U,I)=$P(S,U,I)-(YSCF1*YSCF\1)
|
|
HDAA ;DEP/ANX
|
|
D RD^YTMCMI2A S YSIO=$E(X,176),YSEP=$E(X,177) S:YSIO'="I" YSIO="O" S:YSEP'?1N YSEP=2
|
|
S YSAS=$P(S,U,17),YSDS=$P(S,U,20),Y=(YSAS-85)+(YSDS-85)
|
|
I YSEP=2,YSIO="I",YSAS>84,YSDS>84 S Y1=Y*.5\1 S:Y1>15 Y1=15 S $P(S,U,5)=$P(S,U,5)-Y1,$P(S,U,13)=$P(S,U,13)-Y1 S Y1=Y*.75\1 S:Y1>15 Y1=15 S $P(S,U,15)=$P(S,U,15)-Y1
|
|
I YSIO="I",YSEP=1,YSAS>84,YSDS>84 S Y1=Y S:Y>25 Y1=25 S $P(S,U,5)=$P(S,U,5)-Y1,$P(S,U,13)=$P(S,U,13)-Y1 S:Y1>20 Y1=20 S $P(S,U,15)=$P(S,U,15)-Y1
|
|
I YSIO="I",YSEP>2,YSAS>84,YSDS>84 S Y1=Y*.25\1 S:Y1>15 Y1=15 S $P(S,U,5)=$P(S,U,5)-Y1,$P(S,U,13)=$P(S,U,13)-Y1 S Y1=Y*.5\1 S:Y1>10 Y1=10 S $P(S,U,15)=$P(S,U,15)-Y1
|
|
I YSIO="O",YSAS>84,YSDS>84 S Y1=((YSAS-85)+(YSDS-85))\4 S:Y1>15 Y1=15 S $P(S,U,5)=$P(S,U,5)-Y1,$P(S,U,13)=$P(S,U,13)-Y1 S Y1=Y*.5\1 S:Y1>10 Y1=10 S $P(S,U,15)=$P(S,U,15)-Y1
|
|
I YSIO="I",YSEP=2,YSDS>84,YSAS<85 S Y1=YSDS-85*.5\1 S:Y1>15 Y1=15 S $P(S,U,5)=$P(S,U,5)-Y1,$P(S,U,13)=$P(S,U,13)-Y1 S Y1=YSDS-85*.75\1 S:Y1>15 Y1=15 S $P(S,U,15)=$P(S,U,15)-Y1
|
|
I YSIO="I",YSEP=1,YSDS>84,YSAS<85 S Y1=YSDS-85 S:Y1>25 Y1=25 S $P(S,U,5)=$P(S,U,5)-Y1,$P(S,U,13)=$P(S,U,13)-Y1 S:Y1>20 Y1=20 S $P(S,U,15)=$P(S,U,15)-Y1
|
|
I YSIO="I",YSEP>2,YSDS>84,YSAS<85 S Y1=YSDS-85*.25\1 S:Y1>15 Y1=15 S $P(S,U,5)=$P(S,U,5)-Y1,$P(S,U,13)=$P(S,U,13)-Y1 S Y1=YSDS-85*.5\1 S:Y1>10 Y1=10 S $P(S,U,15)=$P(S,U,15)-Y1
|
|
I YSIO="O",YSDS>84,YSAS<85 S Y1=YSDS-85*.25\1 S:Y1>15 Y1=15 S $P(S,U,5)=$P(S,U,5)-Y1,$P(S,U,13)=$P(S,U,13)-Y1 S Y1=YSDS-85*.5\1 S:Y1>10 Y1=10 S $P(S,U,15)=$P(S,U,15)-Y1
|
|
XYZ ;Y-Z C
|
|
S Y1=$P(S,U,2)-$P(S,U,3)/10,Y1=$J(Y1,0,0) S:Y1>10 Y1=10 S:Y1<-10 Y1=-10 F I=14,15,17,18,20 S $P(S,U,I)=$P(S,U,I)+Y1
|
|
DCA K YSS,YSS1,YSS2,^TMP("YT1",$J) F I=4:1:13 S ^TMP("YT1",$J,999-$P(S,U,I),I)=""
|
|
S Y1=$O(^TMP("YT1",$J,0)),Y2=0 F I=0:1 S Y2=$O(^TMP("YT1",$J,Y1,Y2)) Q:Y2'>0 S YSS1(Y2)=""
|
|
I I<2 S Y1=$O(^TMP("YT1",$J,Y1)),Y2=0 F I=0:1 S Y2=$O(^TMP("YT1",$J,Y1,Y2)) Q:Y2'>0 S YSS2(Y2)=""
|
|
TIES S YSS1="",YSS2="" I YSSEX="M" F I=13,4,7,9,10,6,8,11,12,5 S:$D(YSS1(I)) YSS1=YSS1_I_U S:$D(YSS2(I)) YSS2=YSS2_I_U
|
|
I YSSEX="F" F I=9,4,10,8,5,12,13,11,7,6 S:$D(YSS1(I)) YSS1=YSS1_I_U S:$D(YSS2(I)) YSS2=YSS2_I_U
|
|
S YSS=YSS1_YSS2
|
|
I +YSS=7!(+YSS=8)!(+YSS=11)!($P(YSS,U,2)=11) F I=14,15,16,17,20,18 S Y1=$S(I<16:4,I=16:2,I=18:13,1:15) S $P(S,U,I)=$P(S,U,I)+Y1
|
|
I +YSS=13!(+YSS=5)!($P(YSS,U,2)=5) F I=15,16,14,17,18,20 S Y1=$S(I=14:2,I<17:6,I=17:7,1:5) S $P(S,U,I)=$P(S,U,I)-Y1
|
|
SCP ; LAST COR
|
|
I YSIO="I",YSEP=1 F I="23,8","24,10","25,4" S $P(S,U,+I)=$P(S,U,+I)+$P(I,",",2)
|
|
I YSIO="I",(YSEP=2!(YSEP=0)) F I="23,5","24,7","25,2" S $P(S,U,+I)=$P(S,U,+I)+$P(I,",",2)
|
|
K Y,Y1,^TMP("YT1",$J) S S(1)=$P(S,U,1,13),S(2)=$P(S,U,14,26),R(1)=$P(R,U,1,13),R(2)=$P(R,U,14,26),(S,R)=""
|
|
K YSTY,X,Y,A,B,K,YSKK,L,L1,L2,M,J,YSIT,YSRS,YSSS,I,P,YSMX,YSTL,YSTTL Q
|