source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTMMPI2A.m@ 1489

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