YTMMPI2B ;ALB/ASF-MMPI2 HARRIS:LINGOS,CRIT,OS ;6/19/03 14:43
;;5.01;MENTAL HEALTH;**10,31,76,70**;Dec 30, 1994
SCOR ;
S (R,S)="" F J=44:1:84 D T0^YTMMPI2A S P=YSSX D LK^YTMMPI2A
K A,YSTVL S YSSCALE=S,YSRAW=R
D HL,WAIT:IOST?1"C-".E Q:YSLFT
D SI Q:YSLFT
;D OS,WAIT:IOST?1"C-".E Q:YSLFT
D NEWSC,WAIT:(IOST?1"C".E)&($Y+4>IOSL) Q:YSLFT
D PSY5,WAIT:(IOST?1"C".E)&($Y+4>IOSL) Q:YSLFT
D RCCLIN,WAIT:IOST?1"C".E Q:YSLFT
;I $D(^YTT(601,YSTEST,"S",107)) D ^YTMMPI2D,WAIT:IOST?1"C-".E Q:YSLFT
D CRIT,WAIT:IOST?1"C-".E Q:YSLFT D:(X(0)["X")!(X(1)["X")!(X(2)["X") OMIT,WAIT:IOST?1"C-".E Q:YSLFT D NK^YTMMPI2P Q
HL ;HARRIS LINGOS
D DTA^YTREPT W !!!?25,"Harris-Lingoes Subscales",!?10,"(to be used as an aid in interpreting the parent scale)",!!?50,"Raw Score",?65,"T Score"
F J=44:1:71 S YSN=$P(^YTT(601,YSTEST,"S",J,0),U,2),R=$P(YSRAW,U,J-43),S=$P(YSSCALE,U,J-43) D:YSN?.E1"1".E HLPARNT W !?3,$E($P(YSN," ",2,9),1,36)," (",$P(YSN," "),")",?50,$J(R,4),?65,$J(S,4) D:$Y+4>IOSL&(IOST?1"C-".E) WAIT Q:YSLFT
Q
HLPARNT ;
W:J'=44 !! W !,$S(J=44:"Depression",J=49:"Hysteria",J=54:"Psychopathic Deviate",J=59:"Paranoia",J=62:"Schizophrenia",1:"Hypomania")," Subscales",! Q
WAIT ;
I IOST'?1"C-".E D DTA^YTREPT Q
; %% ANOTHER READER CALL ???? LOOK YSLFT = YSTOUT %%%
W $C(7) R YSLFT:DTIME S YSTOUT='$T,YSUOUT=YSLFT["^"
S:YSLFT["^"!'$T YSLFT=1 Q:YSLFT S Z1=1 W # Q
SI ;
D DTA^YTREPT W !!!?25,"Social Introversion Subscales",!?18,"(Ben-Porath, Hostetler, Butcher, and Graham)",!!?50,"Raw Score",?65,"T Score"
F J=72:1:74 S YSN=$P(^YTT(601,YSTEST,"S",J,0),U,2),R=$P(YSRAW,U,J-43),S=$P(YSSCALE,U,J-43) W !?3,$E($P(YSN," ",2,9),1,36)," (",$P(YSN," "),")",?50,$J(R,4),?65,$J(S,4) D:$Y+4>IOSL WAIT Q:YSLFT
Q
OS ;OBVIOUS SUBTLE
W !!!!?25,"Wiener-Harmon Subtle-Obvious Subscales",!!?50,"Raw Score",?65,"T Score"
F J=75:1:84 S YSN=$P(^YTT(601,YSTEST,"S",J,0),U,2),R=$P(YSRAW,U,J-43),S=$P(YSSCALE,U,J-43) W !?3,$E($P(YSN," ",2,9),1,36)," (",$P(YSN," "),")",?50,$J(R,4),?65,$J(S,4) D:$Y+4>IOSL WAIT Q:YSLFT
S S=$P(YSSCALE,U,32,41) W !!?3,"Total T Score Difference (Obvious-Subtle): ",$P(S,U)+$P(S,U,3)+$P(S,U,5)+$P(S,U,7)+$P(S,U,9)-$P(S,U,2)-$P(S,U,4)-$P(S,U,6)-$P(S,U,8)-$P(S,U,10)
Q
NEWSC ;scales AAS,AAP,marital,fp S,hostility
Q:'$D(^YTT(601,YSTEST,"S",107))
W !!?25,"Additional Supplementary Scales",!
S (R,S)="" F J=107:1:112 D T0^YTMMPI2A S P=YSSX D LK^YTMMPI2A
K A,YSTVL S YSSCALE=S,YSRAW=R
F J=107:1:112 S YSN=$P(^YTT(601,YSTEST,"S",J,0),U,2),R=$P(YSRAW,U,J-106),S=$P(YSSCALE,U,J-106) W !?3,$E($P(YSN," ",2,9),1,36)," (",$P(YSN," "),")",?50,$J(R,4),?65,$J(S,4) D:$Y+4>IOSL WAIT Q:YSLFT
W !!,"Uniform T scores are used for HS, D, Hy, Pd, Pa, Pt, Sc, Ma, and",!,"the Content Scales; all other MMPI-2 scales use linear T scores.",! Q
PSY5 ; ADDED 8/30/02 ASF
Q:'$D(^YTT(601,YSTEST,"S",114))
W !?25,"PSY-5 Personality Psychopathology Five",!?50,"Raw Score",?65,"T Score"
S (R,S)="" F J=114:1:118 D T0^YTMMPI2A S P=YSSX D LK^YTMMPI2A
K A,YSTVL S YSSCALE=S,YSRAW=R
F J=114:1:118 S YSN=$P(^YTT(601,YSTEST,"S",J,0),U,2),R=$P(YSRAW,U,J-113),S=$P(YSSCALE,U,J-113) W !?3,YSN,?50,$J(R,4),?65,$J(S,4) D:$Y+4>IOSL WAIT Q:YSLFT
Q
RCCLIN ;restructured clinical
Q:$G(^YTT(601,YSTEST,"S",119,0))'?.E1"RC".E
W !!?25,"RC Restructured Clinical Scales",!?50,"Raw Score",?65,"T Score"
S (R,S)="" F J=119:1:127 D T0^YTMMPI2A S P=YSSX D LK^YTMMPI2A
K A,YSTVL S YSSCALE=S,YSRAW=R
F J=119:1:127 S YSN=$P(^YTT(601,YSTEST,"S",J,0),U,2),R=$P(YSRAW,U,J-118),S=$P(YSSCALE,U,J-118) W !?3,YSN,?50,$J(R,4),?65,$J(S,4) D:$Y+4>IOSL WAIT Q:YSLFT
Q
CRIT ;CRITICAL ITEMS
D DTA^YTREPT W !?25,"Critical Items",!! S N=0 F I=1:1 S N=$O(^YTT(601,YSTEST,"G",1,1,N)) Q:'N W !,^(N,0)
S YSCNT=0 F J=85,88,86,89,87,90 D CRIT1 Q:YSLFT
Q:YSLFT W !!!,YSCNT," Koss-Butcher Critical Items were endorsed."
S YSCNT=0 F J=91:1:100,106 D CRIT1 Q:YSLFT
Q:YSLFT W !!!,YSCNT," Lachar-Wrobel Critical Items were endorsed."
Q
CRIT1 ;
S YSN=$P(^YTT(601,YSTEST,"S",J,0),U,2),YSKY=$S($D(^YTT(601,YSTEST,"S",J,YSSX_"K")):^(YSSX_"K"),1:^YTT(601,YSTEST,"S",J,"K",1,0))
I $D(^YTT(601,YSTEST,"S",J,"K",2,0)) S YSKY=YSKY_^(0)
S X(0)=^YTD(601.2,YSDFN,1,YSTEST,1,YSED,1),X(1)=^(2),X(2)=^(3) D:$Y+4>IOSL WAIT Q:YSLFT W !!!,YSN,!
F I=1:2 S YSIT=$P(YSKY,U,I) Q:YSIT'?1N.N S B=$P(YSKY,U,I+1) I $E(X(YSIT\200),YSIT#200)=B S YSCNT=YSCNT+1 D L,WAIT:$Y+4>IOSL
Q
L W !,$J(YSIT,5),". " F K=1:1 Q:'$D(^YTT(601,YSTEST,"Q",YSIT,"T",K)) W:K'=1 !?7 W ^YTT(601,YSTEST,"Q",YSIT,"T",K,0)
W:B'="X" " (",B,")" Q
OMIT ;OMITTED ITEMS
D DTA^YTREPT W !!!?25,"OMITTED ITEMS",!!!,"The following items were omitted by the client. It may be helpful to",!,"discuss these items with this individual to determine the reason",!,"for non-compliance with test instructions.",!!!
S B="X" F I=0,1,2 I X(I)["X" F J=1:1:$L(X(I)) I $E(X(I),J)="X" S YSIT=J+(200*I) D L
D WAIT Q
VV ;
S N=0 F S N=$O(^YTT(601,202,"S",N)) Q:'N S G=^(N,0) W !,N,?5,$P(G,U),?10,$P(G,U,2)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTMMPI2B 4970 printed Oct 16, 2024@18:18:30 Page 2
YTMMPI2B ;ALB/ASF-MMPI2 HARRIS:LINGOS,CRIT,OS ;6/19/03 14:43
+1 ;;5.01;MENTAL HEALTH;**10,31,76,70**;Dec 30, 1994
SCOR ;
+1 SET (R,S)=""
FOR J=44:1:84
DO T0^YTMMPI2A
SET P=YSSX
DO LK^YTMMPI2A
+2 KILL A,YSTVL
SET YSSCALE=S
SET YSRAW=R
+3 DO HL
if IOST?1"C-".E
DO WAIT
if YSLFT
QUIT
+4 DO SI
if YSLFT
QUIT
+5 ;D OS,WAIT:IOST?1"C-".E Q:YSLFT
+6 DO NEWSC
if (IOST?1"C".E)&($Y+4>IOSL)
DO WAIT
if YSLFT
QUIT
+7 DO PSY5
if (IOST?1"C".E)&($Y+4>IOSL)
DO WAIT
if YSLFT
QUIT
+8 DO RCCLIN
if IOST?1"C".E
DO WAIT
if YSLFT
QUIT
+9 ;I $D(^YTT(601,YSTEST,"S",107)) D ^YTMMPI2D,WAIT:IOST?1"C-".E Q:YSLFT
+10 DO CRIT
if IOST?1"C-".E
DO WAIT
if YSLFT
QUIT
if (X(0)["X")!(X(1)["X")!(X(2)["X")
DO OMIT
if IOST?1"C-".E
DO WAIT
if YSLFT
QUIT
DO NK^YTMMPI2P
QUIT
HL ;HARRIS LINGOS
+1 DO DTA^YTREPT
WRITE !!!?25,"Harris-Lingoes Subscales",!?10,"(to be used as an aid in interpreting the parent scale)",!!?50,"Raw Score",?65,"T Score"
+2 FOR J=44:1:71
SET YSN=$PIECE(^YTT(601,YSTEST,"S",J,0),U,2)
SET R=$PIECE(YSRAW,U,J-43)
SET S=$PIECE(YSSCALE,U,J-43)
if YSN?.E1"1".E
DO HLPARNT
WRITE !?3,$EXTRACT($PIECE(YSN," ",2,9),1,36)," (",$PIECE(YSN," "),")",?50,$JUSTIFY(R,4),?65,$JUSTIFY(S,4)
if $Y+4>IOSL&(IOST?1"C-".E)
DO WAIT
if YSLFT
QUIT
+3 QUIT
HLPARNT ;
+1 if J'=44
WRITE !!
WRITE !,$SELECT(J=44:"Depression",J=49:"Hysteria",J=54:"Psychopathic Deviate",J=59:"Paranoia",J=62:"Schizophrenia",1:"Hypomania")," Subscales",!
QUIT
WAIT ;
+1 IF IOST'?1"C-".E
DO DTA^YTREPT
QUIT
+2 ; %% ANOTHER READER CALL ???? LOOK YSLFT = YSTOUT %%%
+3 WRITE $CHAR(7)
READ YSLFT:DTIME
SET YSTOUT='$TEST
SET YSUOUT=YSLFT["^"
+4 if YSLFT["^"!'$TEST
SET YSLFT=1
if YSLFT
QUIT
SET Z1=1
WRITE #
QUIT
SI ;
+1 DO DTA^YTREPT
WRITE !!!?25,"Social Introversion Subscales",!?18,"(Ben-Porath, Hostetler, Butcher, and Graham)",!!?50,"Raw Score",?65,"T Score"
+2 FOR J=72:1:74
SET YSN=$PIECE(^YTT(601,YSTEST,"S",J,0),U,2)
SET R=$PIECE(YSRAW,U,J-43)
SET S=$PIECE(YSSCALE,U,J-43)
WRITE !?3,$EXTRACT($PIECE(YSN," ",2,9),1,36)," (",$PIECE(YSN," "),")",?50,$JUSTIFY(R,4),?65,$JUSTIFY(S,4)
if $Y+4>IOSL
DO WAIT
if YSLFT
QUIT
+3 QUIT
OS ;OBVIOUS SUBTLE
+1 WRITE !!!!?25,"Wiener-Harmon Subtle-Obvious Subscales",!!?50,"Raw Score",?65,"T Score"
+2 FOR J=75:1:84
SET YSN=$PIECE(^YTT(601,YSTEST,"S",J,0),U,2)
SET R=$PIECE(YSRAW,U,J-43)
SET S=$PIECE(YSSCALE,U,J-43)
WRITE !?3,$EXTRACT($PIECE(YSN," ",2,9),1,36)," (",$PIECE(YSN," "),")",?50,$JUSTIFY(R,4),?65,$JUSTIFY(S,4)
if $Y+4>IOSL
DO WAIT
if YSLFT
QUIT
+3 SET S=$PIECE(YSSCALE,U,32,41)
WRITE !!?3,"Total T Score Difference (Obvious-Subtle): ",$PIECE(S,U)+$PIECE(S,U,3)+$PIECE(S,U,5)+$PIECE(S,U,7)+$PIECE(S,U,9)-$PIECE(S,U,2)-$PIECE(S,U,4)-$PIECE(S,U,6)-$PIECE(S,U,8)-$PIECE(S,U,10)
+4 QUIT
NEWSC ;scales AAS,AAP,marital,fp S,hostility
+1 if '$DATA(^YTT(601,YSTEST,"S",107))
QUIT
+2 WRITE !!?25,"Additional Supplementary Scales",!
+3 SET (R,S)=""
FOR J=107:1:112
DO T0^YTMMPI2A
SET P=YSSX
DO LK^YTMMPI2A
+4 KILL A,YSTVL
SET YSSCALE=S
SET YSRAW=R
+5 FOR J=107:1:112
SET YSN=$PIECE(^YTT(601,YSTEST,"S",J,0),U,2)
SET R=$PIECE(YSRAW,U,J-106)
SET S=$PIECE(YSSCALE,U,J-106)
WRITE !?3,$EXTRACT($PIECE(YSN," ",2,9),1,36)," (",$PIECE(YSN," "),")",?50,$JUSTIFY(R,4),?65,$JUSTIFY(S,4)
if $Y+4>IOSL
DO WAIT
if YSLFT
QUIT
+6 WRITE !!,"Uniform T scores are used for HS, D, Hy, Pd, Pa, Pt, Sc, Ma, and",!,"the Content Scales; all other MMPI-2 scales use linear T scores.",!
QUIT
PSY5 ; ADDED 8/30/02 ASF
+1 if '$DATA(^YTT(601,YSTEST,"S",114))
QUIT
+2 WRITE !?25,"PSY-5 Personality Psychopathology Five",!?50,"Raw Score",?65,"T Score"
+3 SET (R,S)=""
FOR J=114:1:118
DO T0^YTMMPI2A
SET P=YSSX
DO LK^YTMMPI2A
+4 KILL A,YSTVL
SET YSSCALE=S
SET YSRAW=R
+5 FOR J=114:1:118
SET YSN=$PIECE(^YTT(601,YSTEST,"S",J,0),U,2)
SET R=$PIECE(YSRAW,U,J-113)
SET S=$PIECE(YSSCALE,U,J-113)
WRITE !?3,YSN,?50,$JUSTIFY(R,4),?65,$JUSTIFY(S,4)
if $Y+4>IOSL
DO WAIT
if YSLFT
QUIT
+6 QUIT
RCCLIN ;restructured clinical
+1 if $GET(^YTT(601,YSTEST,"S",119,0))'?.E1"RC".E
QUIT
+2 WRITE !!?25,"RC Restructured Clinical Scales",!?50,"Raw Score",?65,"T Score"
+3 SET (R,S)=""
FOR J=119:1:127
DO T0^YTMMPI2A
SET P=YSSX
DO LK^YTMMPI2A
+4 KILL A,YSTVL
SET YSSCALE=S
SET YSRAW=R
+5 FOR J=119:1:127
SET YSN=$PIECE(^YTT(601,YSTEST,"S",J,0),U,2)
SET R=$PIECE(YSRAW,U,J-118)
SET S=$PIECE(YSSCALE,U,J-118)
WRITE !?3,YSN,?50,$JUSTIFY(R,4),?65,$JUSTIFY(S,4)
if $Y+4>IOSL
DO WAIT
if YSLFT
QUIT
+6 QUIT
CRIT ;CRITICAL ITEMS
+1 DO DTA^YTREPT
WRITE !?25,"Critical Items",!!
SET N=0
FOR I=1:1
SET N=$ORDER(^YTT(601,YSTEST,"G",1,1,N))
if 'N
QUIT
WRITE !,^(N,0)
+2 SET YSCNT=0
FOR J=85,88,86,89,87,90
DO CRIT1
if YSLFT
QUIT
+3 if YSLFT
QUIT
WRITE !!!,YSCNT," Koss-Butcher Critical Items were endorsed."
+4 SET YSCNT=0
FOR J=91:1:100,106
DO CRIT1
if YSLFT
QUIT
+5 if YSLFT
QUIT
WRITE !!!,YSCNT," Lachar-Wrobel Critical Items were endorsed."
+6 QUIT
CRIT1 ;
+1 SET YSN=$PIECE(^YTT(601,YSTEST,"S",J,0),U,2)
SET YSKY=$SELECT($DATA(^YTT(601,YSTEST,"S",J,YSSX_"K")):^(YSSX_"K"),1:^YTT(601,YSTEST,"S",J,"K",1,0))
+2 IF $DATA(^YTT(601,YSTEST,"S",J,"K",2,0))
SET YSKY=YSKY_^(0)
+3 SET X(0)=^YTD(601.2,YSDFN,1,YSTEST,1,YSED,1)
SET X(1)=^(2)
SET X(2)=^(3)
if $Y+4>IOSL
DO WAIT
if YSLFT
QUIT
WRITE !!!,YSN,!
+4 FOR I=1:2
SET YSIT=$PIECE(YSKY,U,I)
if YSIT'?1N.N
QUIT
SET B=$PIECE(YSKY,U,I+1)
IF $EXTRACT(X(YSIT\200),YSIT#200)=B
SET YSCNT=YSCNT+1
DO L
if $Y+4>IOSL
DO WAIT
+5 QUIT
L WRITE !,$JUSTIFY(YSIT,5),". "
FOR K=1:1
if '$DATA(^YTT(601,YSTEST,"Q",YSIT,"T",K))
QUIT
if K'=1
WRITE !?7
WRITE ^YTT(601,YSTEST,"Q",YSIT,"T",K,0)
+1 if B'="X"
WRITE " (",B,")"
QUIT
OMIT ;OMITTED ITEMS
+1 DO DTA^YTREPT
WRITE !!!?25,"OMITTED ITEMS",!!!,"The following items were omitted by the client. It may be helpful to",!,"discuss these items with this individual to determine the reason",!,"for non-compliance with test instructions.",!!!
+2 SET B="X"
FOR I=0,1,2
IF X(I)["X"
FOR J=1:1:$LENGTH(X(I))
IF $EXTRACT(X(I),J)="X"
SET YSIT=J+(200*I)
DO L
+3 DO WAIT
QUIT
VV ;
+1 SET N=0
FOR
SET N=$ORDER(^YTT(601,202,"S",N))
if 'N
QUIT
SET G=^(N,0)
WRITE !,N,?5,$PIECE(G,U),?10,$PIECE(G,U,2)
