61 lines
2.9 KiB
Mathematica
61 lines
2.9 KiB
Mathematica
YTMMPI2A ;ALB/ASF-MMPI2 REPORT; ;4/21/92 08:54
|
|
;;5.01;MENTAL HEALTH;;Dec 30, 1994
|
|
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 Q
|
|
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
|
|
SUP ;SUPPLEMENTARY SCALES
|
|
K A S (R,S)="" F J=14:1:17,20:1:28 D T0
|
|
D TRIN,STS,HDS Q:YSLFT
|
|
CNTNT ;CONTENT SCALES
|
|
K A S (R,S)="" F J=29:1:43 D T0
|
|
D STC,HDC Q:YSLFT
|
|
D ^YTMMPI2B Q
|
|
HDC ;
|
|
S YSNS=15,YSSK="C",YSSNM="ANX,FRS,OBS,DEP,HEA,BIZ,ANG,CYN,ASP,TPA,LSE,SOD,FAM,WRK,TRT" W @IOF,!!?25,"Content Scales Profile",!?15,"Butcher, Graham, Williams, and Ben-Porath (1989)",!
|
|
D ^YTMMPI2P Q:YSLFT D BOTTM Q
|
|
TRIN ;TRUE RESPONSE SCALE
|
|
S X1=^YTD(601.2,YSDFN,1,YSET,1,YSED,1),X2=^(2),X3=^(3)
|
|
S A(18)=9 F J=1:1 Q:'$D(^YTT(601,YSTEST,"S",18,"K",J,0)) S G=^(0) F I=1:1:$L(G,"^") D INCON S:YSF&(YSB1="T") A(18)=A(18)+1 S:YSF&(YSB1="F") A(18)=A(18)-1
|
|
VRIN ;VARIABLE RESPONSE SCALE
|
|
S A(19)=0 F J=1:1 Q:'$D(^YTT(601,YSTEST,"S",19,"K",J,0)) S G=^(0) F I=1:1:$L(G,"^") D INCON S:YSF A(19)=A(19)+1
|
|
Q
|
|
STS ;
|
|
S (R,S)="",P=YSSX F J=14:1:28 D LK
|
|
K YSTVL S YSSCALE=S,YSRAW=R Q
|
|
STC ;
|
|
S (R,S)="",P=YSSX F J=29:1:43 D LK
|
|
K YSTVL S YSSCALE=S,YSRAW=R Q
|
|
HDS ;
|
|
S YSNS=15,YSSK="S",YSSNM="A ,R ,Es,FB,TR,VR,OH,Do,RE,Mt,GM,GF,PK,PS,MAC-R"
|
|
W @IOF,!!?25,"Supplementary Scales Profile",! D ^YTMMPI2P Q:YSLFT D BOTTM Q
|
|
BOTTM ;
|
|
W !?YSLM+6 F I=1:1:YSNS W $E($P(YSSNM,",",I)_" ",1,4)
|
|
W:YSSK="S" "R" W !,"Raw",!,"Score: " F I=1:1:YSNS W $J($P(YSRAW,U,I),4)
|
|
W !!,"T Score: " F I=1:1:YSNS W $J($P(S,U,I),4)
|
|
W !! D DTA^YTMMPI2P,WAIT^YTMMPI2P:IOST?1"C-".E Q
|
|
INCON ;
|
|
S Y=$P(G,U,I),YSIT1=+Y,YSB1=$P(Y,","),YSB1=$E(YSB1,$L(YSB1)),YSIT2=+$P(Y,",",2),YSB2=$E(Y,$L(Y))
|
|
S YSF=0,X=$S(YSIT1>400:3,YSIT1>200:2,1:1) S Y=@("X"_X),YSOFF=X-1*200,Y=$E(Y,YSIT1-YSOFF) Q:Y'=YSB1 S YSF=1
|
|
S YSF=0,X=$S(YSIT2>400:3,YSIT2>200:2,1:1) S Y=@("X"_X),YSOFF=X-1*200,Y=$E(Y,YSIT2-YSOFF) S:Y=YSB2 YSF=1 Q
|
|
LK S A=A(J),R=R_A_U,L1=$P(^YTT(601,YSTEST,"S",J,P),U) I A<L1 S YSTVL=$P(^(P),U,2) G LK1
|
|
S YSTVL=$P(^(P),U,A+2-L1) I YSTVL="" S YSTVL=$P(^(P),U,$L(^(P),"^"))
|
|
LK1 ;
|
|
S S=S_YSTVL_"^" Q
|
|
SHORT ;MOVE MMPI2 INCOMPLETE TO SHORT FORM
|
|
S S=$O(^YTT(601,"B","MMP2S",0)),C=$O(^YTT(601,"B","CLERK",0)),F=$O(^YTT(601,"B","MMPI2",0))
|
|
D ^YSLRP Q:YSDFN'>0 I '$D(^YTD(601.4,YSDFN,1,C))!($P(^(C,0),U,6)'=F) W !!,"No Incomplete MMPI-2 found for this patient" H 3 Q
|
|
I '$D(^YTD(601.4,YSDFN,1,C,2))!($L(^(2))<170) W !,"Patient did not answer the required 370 questions" H 3 Q
|
|
L +^YTD(601.4,YSDFN) S ^YTD(601.4,YSDFN,1,S,0)=^YTD(601.4,YSDFN,1,C,0),YSORD=$P(^(0),U,7),^YTD(601.4,YSDFN,1,S,1)=^YTD(601.4,YSDFN,1,C,1),^YTD(601.4,YSDFN,1,S,2)=$E(^YTD(601.4,YSDFN,1,C,2),1,170)
|
|
L -^YTD(601.4,YSDFN) S DIK="^YTD(601.4,YSDFN,1,",DA=C,DA(1)=YSDFN D ^DIK K DA,DIK
|
|
S YSRP="",(YSEN,YSTEST)=S D ^YTFILE W !,"DONE",$C(7) H 1 Q
|