YTMMP5 ;SLC/DKG-TEST PKG: MMPI SCALES (CONT.) ; 10/20/88 09:11 ;
;;5.01;MENTAL HEALTH;;Dec 30, 1994
;
I IOST?1"C-".E,($Y>0) D WAIT G:YSLFT END
S YSNSS="",(M,YSNS9,YSNS26,YSNS39,YSHP1,YSHP2)=0,YSLFT=0,YSMMPR=$O(^YTT(601,"B","MMPR",0)) F L=1:1:13 S T(L)=$P(S,U,L)
D DTA^YTREPT W !!?21,"--- PROFILE INTERPRETATION ---",!
W !,"THE FOLLOWING MMPI INTERPRETATION SHOULD BE VIEWED AS A SERIES OF",!,"HYPOTHESES WHICH MAY REQUIRE FURTHER INVESTIGATION.",!
S YSKC=$P(R,U,12)-$P(R,U,13)
G:YSKC<17&(T(12)<100) V10 F N=3:1:7 D PR Q:YSLFT
G ^YTMMP3:YSANLL=2,^YTMMP1
V10 ;
I YSKC>11 S N=2 G V100
G V65:T(12)>69,V35:T(12)<60,V25:T(13)-T(12)>9,V20:T(11)-T(12)<6 S N=8 G V40
V20 ;
S N=$S(T(12)<65!(T(11)>54)!(T(13)>44):22,1:14) G V100
V25 ;
S N=$S(T(13)-T(12)>14:12,1:11) G V55
V35 ;
G:T(13)>64 V50 S N=$S(T(11)<56:22,T(13)>59:10,1:8) G:N'=8 V100
V40 ;
D PR G:YSLFT END I T(11)>63 S N=9 G V100
V50 ;
S N=$S(T(13)>69:12,1:11)
V55 ;
D PR G:YSLFT END I T(11)>59,T(13)-T(12)>9,T(11)-T(12)>9 S N=13 G V100
G V101
V65 ;
S:YSKC>11!(YSKC<8) YSKC=0 G V80:T(11)>65!(T(13)>65),V70:T(12)>79 S N=15 G:'YSKC V100 D PR G:YSLFT END S N=16 G V100
V70 ;
S N=17 G:'YSKC V100 D PR G:YSLFT END S N=18 G V100
V80 ;
G V85:T(13)>65,V101:T(11)<66 S N=20 G V100
V85 ;
S N=$S(T(11)>65:21,1:19)
V100 ;
D PR G:YSLFT END
V101 ;
S T(5)=0 F L=1:1:10 S YSNT(L)=L
A10 ;
S YSIS=0 F L=2:1:10 S:T(L)>T(L-1) YSIS=1,N1=T(L),T(L)=T(L-1),T(L-1)=N1,N1=YSNT(L),YSNT(L)=YSNT(L-1),YSNT(L-1)=N1
G:YSIS A10 F L=1:1:10 S T(L)=$P(S,U,L)
S A=T(YSNT(1)) I A>69 S YSNTY=1 G N35
G N30:A>64,N10:A<60,N30:T(2)>59!(T(6)>59),N10:T(7)<60,N30
N10 ;
S YSNTY=3,N=24 D PR G:YSLFT END G ^YTMMP6
N30 ;
S YSNTY=2,N=23 D PR G:YSLFT END G E0^YTMMP6
N35 ;
S N1=YSNT(1),N2=YSNT(2) G:T(N2)>69 H75
H5 ;
S YSHP1=N1,YSHP2=0 I N1=1 S N=$S(T(1)>84:27,T(1)>74:26,1:25),M=$S(T(1)>84:2,T(1)>74:1,1:0) G H300
I N1=9 S N=$S(T(9)>79:36,T(9)>74:35,1:34) S:T(9)>79 M=6 G H300
S N=$S(N1<5:N1+26,N1<10:N1+25,1:37),M=$S(N1=2:3,N1=4:4,N1=6:5,1:0) G H300
H75 ;
I N1=10!(N2=10) S:N1=10 N1=N2 G:N1=2 H175 S N2=YSNT(3) G:T(N2)<70 H5
S:N1>N2 L=N1,N1=N2,N2=L
S YSHP1=N1,YSHP2=N2 I N1=1,N2=2 G:T(2)>T(1)&(T(1)<T(10)) H299
I N1=1 S N=N2+36,M=$S(N2=2:7,N2=4:10,N2=6:11,N2=8:12,N2=9:13,N2=3:8,1:0) G:N2'=3!(T(1)-T(2)<5)!(T(3)-T(2)<10) H300 D PR G:YSLFT END S N=41,M=9,YSNS9=1 G H300
I N1=2 G:T(2)>T(N2)&(T(N2)<T(10)) H299 S N=$S(N2<5:N2+44,1:N2+43),M=$S(N2=4:16,1:N2+11) S:N2=3&(YSSX="F") N=46 G H300
I N1=3 S N=$S(N2=4:54,1:N2+51),M=$S(N2=4:22,N2=6:23,N2=8:25,1:0) G:N2'=4 H300 D PR G:YSLFT END S N=$S(T(4)-T(3)<6:56,1:55) G H300
I N1=4 S N=N2+56 S:N2<9 M=N2+21 S:N2=6&(YSSX="F") N=61,M=26,YSNS26=1 G H300
I N1=6 S N=$S(N2<9:N2+59,1:71),M=N2+23 G:N2'=8 H300 D PR G:YSLFT END G H255
S N=$S(N1=8:77,N2=8:72,1:76),M=$S(N1=8:37,N2=9:36,1:0) G:N2=9 H300 D PR G:YSLFT END S N=$S(T(7)-T(8)>5:73,T(8)-T(7)<6:75,1:74),M=$S(T(7)-T(8)>5:33,T(8)-T(7)<6:35,1:34) G H300
H175 ;
S YSHP1=10,YSHP2=2,N=53,M=21 G H300
H255 ;
I T(6)-T(7)>9,T(8)-T(7)>9 S N=68 D PR G:YSLFT END
I T(6)>79 S N=69 D PR G:YSLFT END
I T(8)>79 S N=70 D PR G:YSLFT END
G H301
H299 ;
S YSHP1=-1,YSHP2=-1 G H301
H300 ;
D PR G:YSLFT END
H301 ;
G E0^YTMMP6
PR ;
I $Y>51&(IOST?1"P".E) D DTA^YTREPT W !!
F YSJJ=1:1 Q:'$D(^YTT(601,YSMMPR,"G",N,1,YSJJ,0)) D:IOST?1"C-".E WAIT:$Y>(IOSL-4) Q:YSLFT W !,^(0)
S:M YSNSS=YSNSS_M_"^",M=0 W ! Q
WAIT ;
F I0=1:1:(IOSL-$Y-2) W !
;%%% YSLFT TO YSTOUT OR YSUOUT
W !,"Press return to continue or ""^"" to omit Interpretive Report " R YSLFT:DTIME S YSTOUT='$T,YSUOUT=YSLFT["^" S:YSLFT["^"!'$T YSLFT=1
W @IOF K I0 Q
END ;
G C70^YTMMP6
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTMMP5 3655 printed Sep 23, 2025@19:53:48 Page 2
YTMMP5 ;SLC/DKG-TEST PKG: MMPI SCALES (CONT.) ; 10/20/88 09:11 ;
+1 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
+2 ;
+3 IF IOST?1"C-".E
IF ($Y>0)
DO WAIT
if YSLFT
GOTO END
+4 SET YSNSS=""
SET (M,YSNS9,YSNS26,YSNS39,YSHP1,YSHP2)=0
SET YSLFT=0
SET YSMMPR=$ORDER(^YTT(601,"B","MMPR",0))
FOR L=1:1:13
SET T(L)=$PIECE(S,U,L)
+5 DO DTA^YTREPT
WRITE !!?21,"--- PROFILE INTERPRETATION ---",!
+6 WRITE !,"THE FOLLOWING MMPI INTERPRETATION SHOULD BE VIEWED AS A SERIES OF",!,"HYPOTHESES WHICH MAY REQUIRE FURTHER INVESTIGATION.",!
+7 SET YSKC=$PIECE(R,U,12)-$PIECE(R,U,13)
+8 if YSKC<17&(T(12)<100)
GOTO V10
FOR N=3:1:7
DO PR
if YSLFT
QUIT
+9 if YSANLL=2
GOTO ^YTMMP3
GOTO ^YTMMP1
V10 ;
+1 IF YSKC>11
SET N=2
GOTO V100
+2 if T(12)>69
GOTO V65
if T(12)<60
GOTO V35
if T(13)-T(12)>9
GOTO V25
if T(11)-T(12)<6
GOTO V20
SET N=8
GOTO V40
V20 ;
+1 SET N=$SELECT(T(12)<65!(T(11)>54)!(T(13)>44):22,1:14)
GOTO V100
V25 ;
+1 SET N=$SELECT(T(13)-T(12)>14:12,1:11)
GOTO V55
V35 ;
+1 if T(13)>64
GOTO V50
SET N=$SELECT(T(11)<56:22,T(13)>59:10,1:8)
if N'=8
GOTO V100
V40 ;
+1 DO PR
if YSLFT
GOTO END
IF T(11)>63
SET N=9
GOTO V100
V50 ;
+1 SET N=$SELECT(T(13)>69:12,1:11)
V55 ;
+1 DO PR
if YSLFT
GOTO END
IF T(11)>59
IF T(13)-T(12)>9
IF T(11)-T(12)>9
SET N=13
GOTO V100
+2 GOTO V101
V65 ;
+1 if YSKC>11!(YSKC<8)
SET YSKC=0
if T(11)>65!(T(13)>65)
GOTO V80
if T(12)>79
GOTO V70
SET N=15
if 'YSKC
GOTO V100
DO PR
if YSLFT
GOTO END
SET N=16
GOTO V100
V70 ;
+1 SET N=17
if 'YSKC
GOTO V100
DO PR
if YSLFT
GOTO END
SET N=18
GOTO V100
V80 ;
+1 if T(13)>65
GOTO V85
if T(11)<66
GOTO V101
SET N=20
GOTO V100
V85 ;
+1 SET N=$SELECT(T(11)>65:21,1:19)
V100 ;
+1 DO PR
if YSLFT
GOTO END
V101 ;
+1 SET T(5)=0
FOR L=1:1:10
SET YSNT(L)=L
A10 ;
+1 SET YSIS=0
FOR L=2:1:10
if T(L)>T(L-1)
SET YSIS=1
SET N1=T(L)
SET T(L)=T(L-1)
SET T(L-1)=N1
SET N1=YSNT(L)
SET YSNT(L)=YSNT(L-1)
SET YSNT(L-1)=N1
+2 if YSIS
GOTO A10
FOR L=1:1:10
SET T(L)=$PIECE(S,U,L)
+3 SET A=T(YSNT(1))
IF A>69
SET YSNTY=1
GOTO N35
+4 if A>64
GOTO N30
if A<60
GOTO N10
if T(2)>59!(T(6)>59)
GOTO N30
if T(7)<60
GOTO N10
GOTO N30
N10 ;
+1 SET YSNTY=3
SET N=24
DO PR
if YSLFT
GOTO END
GOTO ^YTMMP6
N30 ;
+1 SET YSNTY=2
SET N=23
DO PR
if YSLFT
GOTO END
GOTO E0^YTMMP6
N35 ;
+1 SET N1=YSNT(1)
SET N2=YSNT(2)
if T(N2)>69
GOTO H75
H5 ;
+1 SET YSHP1=N1
SET YSHP2=0
IF N1=1
SET N=$SELECT(T(1)>84:27,T(1)>74:26,1:25)
SET M=$SELECT(T(1)>84:2,T(1)>74:1,1:0)
GOTO H300
+2 IF N1=9
SET N=$SELECT(T(9)>79:36,T(9)>74:35,1:34)
if T(9)>79
SET M=6
GOTO H300
+3 SET N=$SELECT(N1<5:N1+26,N1<10:N1+25,1:37)
SET M=$SELECT(N1=2:3,N1=4:4,N1=6:5,1:0)
GOTO H300
H75 ;
+1 IF N1=10!(N2=10)
if N1=10
SET N1=N2
if N1=2
GOTO H175
SET N2=YSNT(3)
if T(N2)<70
GOTO H5
+2 if N1>N2
SET L=N1
SET N1=N2
SET N2=L
+3 SET YSHP1=N1
SET YSHP2=N2
IF N1=1
IF N2=2
if T(2)>T(1)&(T(1)<T(10))
GOTO H299
+4 IF N1=1
SET N=N2+36
SET M=$SELECT(N2=2:7,N2=4:10,N2=6:11,N2=8:12,N2=9:13,N2=3:8,1:0)
if N2'=3!(T(1)-T(2)<5)!(T(3)-T(2)<10)
GOTO H300
DO PR
if YSLFT
GOTO END
SET N=41
SET M=9
SET YSNS9=1
GOTO H300
+5 IF N1=2
if T(2)>T(N2)&(T(N2)<T(10))
GOTO H299
SET N=$SELECT(N2<5:N2+44,1:N2+43)
SET M=$SELECT(N2=4:16,1:N2+11)
if N2=3&(YSSX="F")
SET N=46
GOTO H300
+6 IF N1=3
SET N=$SELECT(N2=4:54,1:N2+51)
SET M=$SELECT(N2=4:22,N2=6:23,N2=8:25,1:0)
if N2'=4
GOTO H300
DO PR
if YSLFT
GOTO END
SET N=$SELECT(T(4)-T(3)<6:56,1:55)
GOTO H300
+7 IF N1=4
SET N=N2+56
if N2<9
SET M=N2+21
if N2=6&(YSSX="F")
SET N=61
SET M=26
SET YSNS26=1
GOTO H300
+8 IF N1=6
SET N=$SELECT(N2<9:N2+59,1:71)
SET M=N2+23
if N2'=8
GOTO H300
DO PR
if YSLFT
GOTO END
GOTO H255
+9 SET N=$SELECT(N1=8:77,N2=8:72,1:76)
SET M=$SELECT(N1=8:37,N2=9:36,1:0)
if N2=9
GOTO H300
DO PR
if YSLFT
GOTO END
SET N=$SELECT(T(7)-T(8)>5:73,T(8)-T(7)<6:75,1:74)
SET M=$SELECT(T(7)-T(8)>5:33,T(8)-T(7)<6:35,1:34)
GOTO H300
H175 ;
+1 SET YSHP1=10
SET YSHP2=2
SET N=53
SET M=21
GOTO H300
H255 ;
+1 IF T(6)-T(7)>9
IF T(8)-T(7)>9
SET N=68
DO PR
if YSLFT
GOTO END
+2 IF T(6)>79
SET N=69
DO PR
if YSLFT
GOTO END
+3 IF T(8)>79
SET N=70
DO PR
if YSLFT
GOTO END
+4 GOTO H301
H299 ;
+1 SET YSHP1=-1
SET YSHP2=-1
GOTO H301
H300 ;
+1 DO PR
if YSLFT
GOTO END
H301 ;
+1 GOTO E0^YTMMP6
PR ;
+1 IF $Y>51&(IOST?1"P".E)
DO DTA^YTREPT
WRITE !!
+2 FOR YSJJ=1:1
if '$DATA(^YTT(601,YSMMPR,"G",N,1,YSJJ,0))
QUIT
if IOST?1"C-".E
if $Y>(IOSL-4)
DO WAIT
if YSLFT
QUIT
WRITE !,^(0)
+3 if M
SET YSNSS=YSNSS_M_"^"
SET M=0
WRITE !
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 Interpretive Report "
READ YSLFT:DTIME
SET YSTOUT='$TEST
SET YSUOUT=YSLFT["^"
if YSLFT["^"!'$TEST
SET YSLFT=1
+4 WRITE @IOF
KILL I0
QUIT
END ;
+1 GOTO C70^YTMMP6
