64 lines
2.6 KiB
Mathematica
64 lines
2.6 KiB
Mathematica
|
YTMMPI ;SLC/DKG-TEST PKG: MMPI MODIFICATIONS ; 5/1/89 10:23 ;
|
||
|
|
;;5.01;MENTAL HEALTH;;Dec 30, 1994
|
||
|
|
;
|
||
|
|
S J=1,YSANLL=2,YSQ=0 ; YSANLL = 1 FOR PANCHERI, 2 FOR LACHAR, 3 FOR BOTH
|
||
|
|
F I=1:1:3 I $D(^YTD(601.2,YSDFN,1,YSET,1,YSED,I)) S X=^(I),L=$L(X) F K=1:1:L S:$E(X,K)="X" YSQ=YSQ+1
|
||
|
|
T0 ;
|
||
|
|
S L=200,M=0,YSKK=1,YSTL=0 D RD
|
||
|
|
T01X ;
|
||
|
|
I '$D(^YTT(601,YSTEST,"S",J,"K",YSKK,0)) S A(J)=YSTL,J=J+1 G T0:J<14,RD1
|
||
|
|
S Y=^YTT(601,YSTEST,"S",J,"K",YSKK,0),P=1
|
||
|
|
T03X ;
|
||
|
|
S YSIT=$P(Y,U,P) I YSIT="" S YSKK=YSKK+1 G T01X
|
||
|
|
S B=$P(Y,U,P+1),P=P+2
|
||
|
|
T3 ;
|
||
|
|
I YSIT>L S L=L+200,M=M+200 D RD G T3
|
||
|
|
S:$E(X,YSIT-M)=B YSTL=YSTL+1 G T03X
|
||
|
|
RD ;
|
||
|
|
S X=^YTD(601.2,YSDFN,1,YSET,1,YSED,L\200) Q
|
||
|
|
RD1 ;
|
||
|
|
I $P(^YTT(601,YSTEST,0),U)'="M168" G S0
|
||
|
|
I YSSX="F" S:$E(X,69)="F" A(5)=A(5)+1 S:$E(X,133)="T" A(5)=A(5)+1
|
||
|
|
E S:$E(X,69)="T" A(5)=A(5)+1 S:$E(X,133)="F" A(5)=A(5)+1
|
||
|
|
S A(10)=1.649*A(10)+(.232*A(12))+(.340*A(7))+4.565
|
||
|
|
S A(1)=1.317*A(1)+(.712*A(13))+3.827,A(2)=1.241*A(2)+5.329,A(3)=1.238*A(3)+9.122
|
||
|
|
S A(4)=1.339*A(4)+(.640*A(13))-(.227*A(7))+10.307,A(5)=1.542*A(5)+(.377*A(8))-(.300*A(13))+7.301
|
||
|
|
S A(6)=1.263*A(6)+(.230*A(12))+(.197*A(7))+3.424,A(7)=1.664*A(7)+(.418*A(12))+(.953*A(13))+10.547
|
||
|
|
S A(8)=2.965*A(8)+(1.054*A(13))+12.080,A(9)=1.330*A(9)+8.380
|
||
|
|
S A(11)=1.211*A(11)+.333,A(12)=1.646*A(12)+1.443,A(13)=1.610*A(13)+3.63
|
||
|
|
F I=1:1:13 S A(I)=$J(A(I),0,0)
|
||
|
|
G S1
|
||
|
|
S0 ;
|
||
|
|
S A(7)=A(7)+A(13),A(8)=A(8)+A(13),A(9)=A(9)+(.2*A(13)+.5\1),A(1)=A(1)+(.5*A(13)+.5\1),B=.4*A(13)+.5\1
|
||
|
|
S A(4)=A(4)+$S(A(13)=3:2,A(13)=1:1,1:B)
|
||
|
|
S L=200 D RD S YSFC=$E(X,69)_$E(X,133)_$E(X,179)
|
||
|
|
S L=400 D RD S YSFC=YSFC_$E(X,31)_$E(X,97),B="TFTTT" S:YSSX="F" B="FTFFF"
|
||
|
|
F I=1:1:5 S:$E(YSFC,I)=$E(B,I) A(5)=A(5)+1
|
||
|
|
S1 ;
|
||
|
|
S YSFC="44^46^48^50^53^55^58^60^62^64^66^68^70^73"
|
||
|
|
S B=0 I A(12)<14 S B=$P(YSFC,U,A(12)+1)
|
||
|
|
S R="" F I=1:1:13 S R=R_A(I)_"^"
|
||
|
|
K A
|
||
|
|
ST ;
|
||
|
|
S S="",J=1,P=YSSX
|
||
|
|
LK ;
|
||
|
|
S A=$P(R,U,J) G:A="" K0 S L1=$P(^YTT(601,YSTEST,"S",J,P),U) I A<L1 S YSTVL=$P(^(P),U,2) S YSTAR(J)=$S(J'=5:"<",P'=2:"<",1:">") G LK1
|
||
|
|
S YSTVL=$P(^(P),U,A+2-L1) I YSTVL="" S YSTVL=$P(^(P),U,$L(^(P),"^")) S YSTAR(J)=$S(J'=5:">",P'=2:">",1:"<")
|
||
|
|
LK1 ;
|
||
|
|
S S=S_YSTVL_"^",J=J+1 G LK
|
||
|
|
K0 ;
|
||
|
|
K YSTVL S YSSCALE=S,YSRAW=R
|
||
|
|
HD ;
|
||
|
|
S DOT=YSHD W @IOF,! D ^YTMMPP
|
||
|
|
OUT ;
|
||
|
|
K X1,X2,X3,DIC G ^YTMMP1:YSANLL=1,^YTMMP5
|
||
|
|
L30 ;
|
||
|
|
S YSLN=" " I K#10=0 S YSLN=$J(K,3,0)
|
||
|
|
S X3="",YSSP=" ",YSSP4=" " I K=Z S Z=Z-20,YSSP="-",YSSP4="----"
|
||
|
|
F I=11:1:13,1:1:10 S A=YSSP S:$P(YSIX,U,I)=K A="*" S X3=X3_YSSP4_A
|
||
|
|
W !?1,YSLN,"-",$E(X3,4,16),"|",$E(X3,19,65),YSSP,"-",YSLN Q
|
||
|
|
L50 ;
|
||
|
|
F J=2:1:10,12,13 S A(J)=$J($P(X1,U,J),5,0)
|
||
|
|
S A(1)=$J($P(X1,U),4,0),A(11)=$J($P(X1,U,11),4,0)
|
||
|
|
W !,X2,A(11),A(12),A(13),A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10) Q
|