YTMMP4 ;SLC/DKG-TEST PKG: MMPI SCALES (CONT.) ; 7/6/89 11:22 ;
;;5.01;MENTAL HEALTH;;Dec 30, 1994
;
I IOST?1"C-".E,($Y>1) D WAIT G:YSLFT DONE
D DTA^YTREPT W !!!?26,"--- SCALE SCORES ---",!
F J=1:1:3 S X(J)=^YTD(601.2,YSDFN,1,YSET,1,YSED,J)
E ;
W !!!?3," HS D HY PD MF PA PT SC MA SI L F K"
S L1=1,L2=13 D SC
W !!!?3," D-O D-S HY-O HY-S PD-O PD-S PA-O PA-S MA-O MA-S ES A R"
S L1=14,L2=26 D SR,SC
W !!!?3," LB CA DY DO RE PR ST CN D1 D2 D3 D4 D5"
S L1=27,L2=39 D SR,SC
W !!!?3," HY1 HY2 HY3 HY4 HY5 PD1 PD2 PD3 PD4A PD4B PA1 PA2 PA3"
S L1=40,L2=52 D SR,SC
I IOST?1"C-".E D WAIT G:YSLFT DONE
W !!!?3," SC1A SC1B SC2A SC2B SC2C SC3 MA1 MA2 MA3 MA4 MAC ICA HE"
S L1=53,L2=65 D SR,SC
W !!!?3," MAS MF1 MF2 MF3 MF4 MF5 MF6 SI1 SI2 SI3 SI4 SI5 SI6"
S L1=66,L2=78 D SR,SC
W !!!?3," SOC DEP FEM MOR REL AUT PSY ORG FAM HOS PHO HYP HEA"
S L1=79,L2=91 D SR,SC
W !!!?3," TI TII TIII TIV TV TVI TVII OH NPD SK PTSD"
S L1=92,L2=102 D SR,SC
I $D(YSAST) W !!,"'<' or '>' indicates 'T' out of table range"
DONE ;
W ! K A,B,C,DOT,J,K,L,L1,L2,M,N,N1,N2,P,R,S,S1,T,X,Y,YSANLL,YSAST,YSAU,YSHP1,YSHP2,YSIT,YSIT1,YSIT2,YSJJ,YSKC,YSKK,YSLB,YSLE,YSLM,YSLN,YSLV,YSMA,YSMF,YSMMPI
K YSMMPR,YSNS26,YSNS39,YSNS9,YSNSS,YSPD,YSPS,YSRAW,YSRH,YSSCALE,YSSH,YSSI,YSSP,YSSP4,YSTL,YSTVL,YSZ,Z1 Q
SR ;
S R="",S="",J=L1,S1=0,YSPS=YSSX
S1 ;
S YSKK=1,YSTL=0
S2 ;
I '$D(^YTT(601,YSTEST,"S",J,"K",YSKK,0)) S R=R_YSTL_"^" G LK
S Y=^YTT(601,YSTEST,"S",J,"K",YSKK,0),P=1
S3 ;
S YSIT=$P(Y,U,P) I YSIT="" S YSKK=YSKK+1 G S2
S B=$P(Y,U,P+1),P=P+2
S:$E(X(YSIT-1\200+1),YSIT-1#200+1)=B YSTL=YSTL+1 G S3
LK ;
S S1=S1+1,X=^YTT(601,YSTEST,"S",J,YSPS),YSZ=$P(X,U) I YSTL<YSZ S YSTVL=$P(X,U,2),YSTAR(S1)="<" S:J=5&(YSPS=2) YSTAR(S1)=">" G LK1
S YSTVL=$P(X,U,YSTL+2-YSZ) I YSTVL="" S YSTVL=$P(X,U,$L(X,"^")),YSTAR(S1)=">" S:J=5&(YSPS)=2 YSTAR(S1)="<"
LK1 ;
S S=S_YSTVL_"^",J=J+1 G:J'>L2 S1 Q
SC ;
S:$D(YSTAR) YSAST=1 S K=L2-L1+1 W !,"RAW" F J=1:1:K W $J($P(R,U,J),5,0)
W !," T " F J=1:1:K S S1=$P(S,U,J) S:$D(YSTAR(J)) S1=YSTAR(J)_S1 W $J(S1,5)
K YSTAR Q
WAIT ;
F I0=1:1:(IOSL-$Y-2) W !
;%%%% YSLFT TO YSTOUT OR YSUOUT
W !,"Press return to continue or ""^"" to omit Scale Scores " R YSLFT:DTIME S YSTOUT='$T,YSUOUT=YSLFT["^"
S:YSLFT["^"!'$T YSLFT=1
W @IOF K I0 Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTMMP4 2428 printed Sep 23, 2025@19:53:47 Page 2
YTMMP4 ;SLC/DKG-TEST PKG: MMPI SCALES (CONT.) ; 7/6/89 11:22 ;
+1 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
+2 ;
+3 IF IOST?1"C-".E
IF ($Y>1)
DO WAIT
if YSLFT
GOTO DONE
+4 DO DTA^YTREPT
WRITE !!!?26,"--- SCALE SCORES ---",!
+5 FOR J=1:1:3
SET X(J)=^YTD(601.2,YSDFN,1,YSET,1,YSED,J)
E ;
+1 WRITE !!!?3," HS D HY PD MF PA PT SC MA SI L F K"
+2 SET L1=1
SET L2=13
DO SC
+3 WRITE !!!?3," D-O D-S HY-O HY-S PD-O PD-S PA-O PA-S MA-O MA-S ES A R"
+4 SET L1=14
SET L2=26
DO SR
DO SC
+5 WRITE !!!?3," LB CA DY DO RE PR ST CN D1 D2 D3 D4 D5"
+6 SET L1=27
SET L2=39
DO SR
DO SC
+7 WRITE !!!?3," HY1 HY2 HY3 HY4 HY5 PD1 PD2 PD3 PD4A PD4B PA1 PA2 PA3"
+8 SET L1=40
SET L2=52
DO SR
DO SC
+9 IF IOST?1"C-".E
DO WAIT
if YSLFT
GOTO DONE
+10 WRITE !!!?3," SC1A SC1B SC2A SC2B SC2C SC3 MA1 MA2 MA3 MA4 MAC ICA HE"
+11 SET L1=53
SET L2=65
DO SR
DO SC
+12 WRITE !!!?3," MAS MF1 MF2 MF3 MF4 MF5 MF6 SI1 SI2 SI3 SI4 SI5 SI6"
+13 SET L1=66
SET L2=78
DO SR
DO SC
+14 WRITE !!!?3," SOC DEP FEM MOR REL AUT PSY ORG FAM HOS PHO HYP HEA"
+15 SET L1=79
SET L2=91
DO SR
DO SC
+16 WRITE !!!?3," TI TII TIII TIV TV TVI TVII OH NPD SK PTSD"
+17 SET L1=92
SET L2=102
DO SR
DO SC
+18 IF $DATA(YSAST)
WRITE !!,"'<' or '>' indicates 'T' out of table range"
DONE ;
+1 WRITE !
KILL A,B,C,DOT,J,K,L,L1,L2,M,N,N1,N2,P,R,S,S1,T,X,Y,YSANLL,YSAST,YSAU,YSHP1,YSHP2,YSIT,YSIT1,YSIT2,YSJJ,YSKC,YSKK,YSLB,YSLE,YSLM,YSLN,YSLV,YSMA,YSMF,YSMMPI
+2 KILL YSMMPR,YSNS26,YSNS39,YSNS9,YSNSS,YSPD,YSPS,YSRAW,YSRH,YSSCALE,YSSH,YSSI,YSSP,YSSP4,YSTL,YSTVL,YSZ,Z1
QUIT
SR ;
+1 SET R=""
SET S=""
SET J=L1
SET S1=0
SET YSPS=YSSX
S1 ;
+1 SET YSKK=1
SET YSTL=0
S2 ;
+1 IF '$DATA(^YTT(601,YSTEST,"S",J,"K",YSKK,0))
SET R=R_YSTL_"^"
GOTO LK
+2 SET Y=^YTT(601,YSTEST,"S",J,"K",YSKK,0)
SET P=1
S3 ;
+1 SET YSIT=$PIECE(Y,U,P)
IF YSIT=""
SET YSKK=YSKK+1
GOTO S2
+2 SET B=$PIECE(Y,U,P+1)
SET P=P+2
+3 if $EXTRACT(X(YSIT-1\200+1),YSIT-1#200+1)=B
SET YSTL=YSTL+1
GOTO S3
LK ;
+1 SET S1=S1+1
SET X=^YTT(601,YSTEST,"S",J,YSPS)
SET YSZ=$PIECE(X,U)
IF YSTL<YSZ
SET YSTVL=$PIECE(X,U,2)
SET YSTAR(S1)="<"
if J=5&(YSPS=2)
SET YSTAR(S1)=">"
GOTO LK1
+2 SET YSTVL=$PIECE(X,U,YSTL+2-YSZ)
IF YSTVL=""
SET YSTVL=$PIECE(X,U,$LENGTH(X,"^"))
SET YSTAR(S1)=">"
if J=5&(YSPS)=2
SET YSTAR(S1)="<"
LK1 ;
+1 SET S=S_YSTVL_"^"
SET J=J+1
if J'>L2
GOTO S1
QUIT
SC ;
+1 if $DATA(YSTAR)
SET YSAST=1
SET K=L2-L1+1
WRITE !,"RAW"
FOR J=1:1:K
WRITE $JUSTIFY($PIECE(R,U,J),5,0)
+2 WRITE !," T "
FOR J=1:1:K
SET S1=$PIECE(S,U,J)
if $DATA(YSTAR(J))
SET S1=YSTAR(J)_S1
WRITE $JUSTIFY(S1,5)
+3 KILL YSTAR
QUIT
WAIT ;
+1 FOR I0=1:1:(IOSL-$Y-2)
WRITE !
+2 ;%%%% YSLFT TO YSTOUT OR YSUOUT
+3 WRITE !,"Press return to continue or ""^"" to omit Scale Scores "
READ YSLFT:DTIME
SET YSTOUT='$TEST
SET YSUOUT=YSLFT["^"
+4 if YSLFT["^"!'$TEST
SET YSLFT=1
+5 WRITE @IOF
KILL I0
QUIT
