55 lines
2.3 KiB
Mathematica
55 lines
2.3 KiB
Mathematica
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
|