YTMMP2 ;SLC/DKG-TEST PKG: MMPI SCALES (CONT.) ; 7/13/89 14:59 ;
;;5.01;MENTAL HEALTH;;Dec 30, 1994
;
S H=YSHS+YSHY\2,YSSH=YSSC+YSPA\2,YSRH=YSHS+YSHY+YSPT+D\4,YSAU=D+YSPT\2,Z=YSMA+YSPD\2
S YSIS=YSHS-YSHY I YSIS'<0,YSHS>60 S N=$S(YSHS<71:"110^P10",YSHS<81:"108^P10",YSHS<91:"105^P20",1:"102^P20") D GET
S YSIS=YSHY-YSHS I YSIS>0,YSHY>70 S N=$S(YSHY<81:"118^P10",YSHY<91:"115^P20",1:"112^P20") D GET
I YSHY>60,YSHY<71,YSIS>0,YSIS<11 S N=120 D PR
S YSIS=H-YSSH I YSIS'<0,H>79 S N=$S(H<90:"121^P20",1:"124^P20") D GET
S YSIS=D-YSMA I YSIS'<0 S N=$S(D<51:155,D<61:"153^P10",D<66:"150^P20",D<71:"147^P20",D<76:"143^P30",D<81:"139^P30",D<91:"132^P35",1:"127^P40") D GET
S YSIS=YSMA-D I YSIS>0 S N=$S(YSMA<51:170,YSMA<61:169,YSMA<71:"167^P10",YSMA<81:"164^P20",YSMA<91:"160^P30",1:"156^P30") D GET
S YSIS=H-YSSH I YSIS'<0,H<80 S N=$S(H<60:"177^P10",H<70:"174^P20",1:"171^P20") D GET
S YSIS=YSHY-YSPA I YSIS'<0,YSHY>60 S N=$S(YSHY<71:"191^P20",YSHY<81:"188^P20",YSHY<91:"184^P30",1:"179^P40") D GET
I YSHY>50,YSHY<61,YSPD<65,YSMF<65,YSSC<65,YSMA<65 S N="194^P10" D GET
S YSIS=YSPD-YSPT I YSIS>0 S N=$S(YSPD<60:"216^P10",YSPD<70:"213^P20",YSPD<75:"209^P30",YSPD<80:"203^P32",YSPD<90:"200^P31",1:"196^P30") D GET
G NX:H=Z,HGZ:H>Z
I YSMF>64,YSMF<70,H<61,YSSH<61,YSAU<61,YSRH<61,Z<70 S N=$S(Z<60:234,1:233) D PR G NX
S YSIS=Z I YSMF>69 S N=$S(YSMF<76:"226^T79",1:"218^T82") D GET G NX
HGZ S YSIS=H I H>59,YSMF>64 S N=$S(YSMF<70:"235^T82",YSMF<76:"230^T80",1:"223^T82") D GET
NX I YSMF<65,Z<51,H<51,YSSH<51,YSRH<51,YSAU<51 S N=238 D PR
S YSIS=YSPD-YSSI I YSIS>0,YSPA>60 S N=$S(YSPA<71:"250^P20",YSPA<81:"247^P20",YSPA<91:"243^P30",1:"239^P36") D GET
I YSPA>50,YSPA<61,YSIS<6,YSIS>0 S N=253 D PR
I YSPA<61,YSIS>6 S N=254 D PR
S YSIS=YSPT-YSPD I YSIS'<0 S N=$S(YSPT<50:276,YSPT<60:"274^P10",YSPT<65:"272^P10",YSPT<70:"270^P10",YSPT<80:"267^P20",YSPT<90:"260^P34",1:"255^P40") D GET
S YSIS=YSSH-H I YSIS>0,YSSH>59 S N=$S(YSSH<70:"305^P10",YSSH<80:"302^P20",YSSH<90:"298^P30",1:"294^P30") D GET
I YSSH<60,YSIS>0,YSIS<16,D<65,YSPT<65,YSMA<65 S N=307 D PR
S YSIS=Z-YSAU I YSIS>0 S N=$S(Z<51:323,Z<61:"321^P10",Z<71:"319^P10",Z<81:"316^P26",Z<91:"312^P37",1:"308^P45") D GET
S YSIS=YSSI-YSPD I YSIS'<0 S N=$S(YSSI<50:338,YSSI<60:"336^P10",YSSI<70:"334^P10",YSSI<80:"331^P20",YSSI<90:"328^P20",1:"324^P30") D GET
S YSIS=YSPD-YSSI I YSIS>0 S N=$S(YSPD<50:357,YSPD<60:"355^P10",YSPD<70:"352^P20",YSPD<80:"345^P35",YSPD<90:"342^P31",1:"339^P27") D GET
S YSIS=YSAU-Z I YSIS'<0 S N=$S(YSAU<51:373,YSAU<61:"371^P10",YSAU<71:"369^P10",YSAU<81:"366^P26",YSAU<91:"362^P37",1:"358^P45") D GET
G ^YTMMP3
GET S X=$P(N,U,2),N=+N D:X'="" @X
PR I $Y>51 D DTA^YTREPT W !!
F YSJJ=1:1 Q:'$D(^YTT(601,YSMMPI,YSSX,N,1,YSJJ,0)) W !,^(0)
W ! K YSHY,YSPA Q
P10 S N=N+$S(YSIS<11:0,1:1) Q
P20 S N=N+$S(YSIS<11:0,YSIS<21:1,1:2) Q
P30 S N=N+$S(YSIS<11:0,YSIS<21:1,YSIS<31:2,1:3) Q
P40 S N=N+$S(YSIS<11:0,YSIS<21:1,YSIS<31:2,YSIS<41:3,1:4) Q
P35 S N=N+$S(YSIS<6:0,YSIS<11:1,YSIS<16:2,YSIS<21:3,YSIS<26:4,YSIS<31:5,1:6) Q
P36 S N=N+$S(YSIS<16:0,YSIS<26:1,YSIS<36:2,1:3) Q
P45 S N=N+$S(YSIS<11:0,YSIS<26:1,YSIS<46:2,1:3) Q
P26 S N=N+$S(YSIS<11:0,YSIS<26:1,1:2) Q
P27 S N=N+$S(YSIS<16:0,YSIS<26:1,1:2) Q
P31 S N=N+$S(YSIS<16:0,YSIS<31:1,1:2) Q
P32 S N=N+$S(YSIS<6:0,YSIS<11:1,YSIS<16:2,YSIS<21:3,YSIS<31:4,1:5) Q
P34 S N=N+$S(YSIS<5:0,YSIS<10:1,YSIS<15:2,YSIS<20:3,YSIS<25:4,YSIS<29:5,1:6) Q
P37 S N=N+$S(YSIS<11:0,YSIS<21:1,YSIS<36:2,1:3) Q
T79 S N=N+$S(YSIS>79:0,YSIS>70:1,YSIS>60:2,1:3) Q
T80 S N=N+$S(YSIS>80:0,YSIS>69:1,1:2) Q
T82 S N=N+$S(YSIS>79:0,YSIS>69:1,YSIS>59:2,YSIS>54:3,1:4) Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTMMP2 3619 printed Apr 09, 2024@21:20:08 Page 2
YTMMP2 ;SLC/DKG-TEST PKG: MMPI SCALES (CONT.) ; 7/13/89 14:59 ;
+1 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
+2 ;
+3 SET H=YSHS+YSHY\2
SET YSSH=YSSC+YSPA\2
SET YSRH=YSHS+YSHY+YSPT+D\4
SET YSAU=D+YSPT\2
SET Z=YSMA+YSPD\2
+4 SET YSIS=YSHS-YSHY
IF YSIS'<0
IF YSHS>60
SET N=$SELECT(YSHS<71:"110^P10",YSHS<81:"108^P10",YSHS<91:"105^P20",1:"102^P20")
DO GET
+5 SET YSIS=YSHY-YSHS
IF YSIS>0
IF YSHY>70
SET N=$SELECT(YSHY<81:"118^P10",YSHY<91:"115^P20",1:"112^P20")
DO GET
+6 IF YSHY>60
IF YSHY<71
IF YSIS>0
IF YSIS<11
SET N=120
DO PR
+7 SET YSIS=H-YSSH
IF YSIS'<0
IF H>79
SET N=$SELECT(H<90:"121^P20",1:"124^P20")
DO GET
+8 SET YSIS=D-YSMA
IF YSIS'<0
SET N=$SELECT(D<51:155,D<61:"153^P10",D<66:"150^P20",D<71:"147^P20",D<76:"143^P30",D<81:"139^P30",D<91:"132^P35",1:"127^P40")
DO GET
+9 SET YSIS=YSMA-D
IF YSIS>0
SET N=$SELECT(YSMA<51:170,YSMA<61:169,YSMA<71:"167^P10",YSMA<81:"164^P20",YSMA<91:"160^P30",1:"156^P30")
DO GET
+10 SET YSIS=H-YSSH
IF YSIS'<0
IF H<80
SET N=$SELECT(H<60:"177^P10",H<70:"174^P20",1:"171^P20")
DO GET
+11 SET YSIS=YSHY-YSPA
IF YSIS'<0
IF YSHY>60
SET N=$SELECT(YSHY<71:"191^P20",YSHY<81:"188^P20",YSHY<91:"184^P30",1:"179^P40")
DO GET
+12 IF YSHY>50
IF YSHY<61
IF YSPD<65
IF YSMF<65
IF YSSC<65
IF YSMA<65
SET N="194^P10"
DO GET
+13 SET YSIS=YSPD-YSPT
IF YSIS>0
SET N=$SELECT(YSPD<60:"216^P10",YSPD<70:"213^P20",YSPD<75:"209^P30",YSPD<80:"203^P32",YSPD<90:"200^P31",1:"196^P30")
DO GET
+14 if H=Z
GOTO NX
if H>Z
GOTO HGZ
+15 IF YSMF>64
IF YSMF<70
IF H<61
IF YSSH<61
IF YSAU<61
IF YSRH<61
IF Z<70
SET N=$SELECT(Z<60:234,1:233)
DO PR
GOTO NX
+16 SET YSIS=Z
IF YSMF>69
SET N=$SELECT(YSMF<76:"226^T79",1:"218^T82")
DO GET
GOTO NX
HGZ SET YSIS=H
IF H>59
IF YSMF>64
SET N=$SELECT(YSMF<70:"235^T82",YSMF<76:"230^T80",1:"223^T82")
DO GET
NX IF YSMF<65
IF Z<51
IF H<51
IF YSSH<51
IF YSRH<51
IF YSAU<51
SET N=238
DO PR
+1 SET YSIS=YSPD-YSSI
IF YSIS>0
IF YSPA>60
SET N=$SELECT(YSPA<71:"250^P20",YSPA<81:"247^P20",YSPA<91:"243^P30",1:"239^P36")
DO GET
+2 IF YSPA>50
IF YSPA<61
IF YSIS<6
IF YSIS>0
SET N=253
DO PR
+3 IF YSPA<61
IF YSIS>6
SET N=254
DO PR
+4 SET YSIS=YSPT-YSPD
IF YSIS'<0
SET N=$SELECT(YSPT<50:276,YSPT<60:"274^P10",YSPT<65:"272^P10",YSPT<70:"270^P10",YSPT<80:"267^P20",YSPT<90:"260^P34",1:"255^P40")
DO GET
+5 SET YSIS=YSSH-H
IF YSIS>0
IF YSSH>59
SET N=$SELECT(YSSH<70:"305^P10",YSSH<80:"302^P20",YSSH<90:"298^P30",1:"294^P30")
DO GET
+6 IF YSSH<60
IF YSIS>0
IF YSIS<16
IF D<65
IF YSPT<65
IF YSMA<65
SET N=307
DO PR
+7 SET YSIS=Z-YSAU
IF YSIS>0
SET N=$SELECT(Z<51:323,Z<61:"321^P10",Z<71:"319^P10",Z<81:"316^P26",Z<91:"312^P37",1:"308^P45")
DO GET
+8 SET YSIS=YSSI-YSPD
IF YSIS'<0
SET N=$SELECT(YSSI<50:338,YSSI<60:"336^P10",YSSI<70:"334^P10",YSSI<80:"331^P20",YSSI<90:"328^P20",1:"324^P30")
DO GET
+9 SET YSIS=YSPD-YSSI
IF YSIS>0
SET N=$SELECT(YSPD<50:357,YSPD<60:"355^P10",YSPD<70:"352^P20",YSPD<80:"345^P35",YSPD<90:"342^P31",1:"339^P27")
DO GET
+10 SET YSIS=YSAU-Z
IF YSIS'<0
SET N=$SELECT(YSAU<51:373,YSAU<61:"371^P10",YSAU<71:"369^P10",YSAU<81:"366^P26",YSAU<91:"362^P37",1:"358^P45")
DO GET
+11 GOTO ^YTMMP3
GET SET X=$PIECE(N,U,2)
SET N=+N
if X'=""
DO @X
PR IF $Y>51
DO DTA^YTREPT
WRITE !!
+1 FOR YSJJ=1:1
if '$DATA(^YTT(601,YSMMPI,YSSX,N,1,YSJJ,0))
QUIT
WRITE !,^(0)
+2 WRITE !
KILL YSHY,YSPA
QUIT
P10 SET N=N+$SELECT(YSIS<11:0,1:1)
QUIT
P20 SET N=N+$SELECT(YSIS<11:0,YSIS<21:1,1:2)
QUIT
P30 SET N=N+$SELECT(YSIS<11:0,YSIS<21:1,YSIS<31:2,1:3)
QUIT
P40 SET N=N+$SELECT(YSIS<11:0,YSIS<21:1,YSIS<31:2,YSIS<41:3,1:4)
QUIT
P35 SET N=N+$SELECT(YSIS<6:0,YSIS<11:1,YSIS<16:2,YSIS<21:3,YSIS<26:4,YSIS<31:5,1:6)
QUIT
P36 SET N=N+$SELECT(YSIS<16:0,YSIS<26:1,YSIS<36:2,1:3)
QUIT
P45 SET N=N+$SELECT(YSIS<11:0,YSIS<26:1,YSIS<46:2,1:3)
QUIT
P26 SET N=N+$SELECT(YSIS<11:0,YSIS<26:1,1:2)
QUIT
P27 SET N=N+$SELECT(YSIS<16:0,YSIS<26:1,1:2)
QUIT
P31 SET N=N+$SELECT(YSIS<16:0,YSIS<31:1,1:2)
QUIT
P32 SET N=N+$SELECT(YSIS<6:0,YSIS<11:1,YSIS<16:2,YSIS<21:3,YSIS<31:4,1:5)
QUIT
P34 SET N=N+$SELECT(YSIS<5:0,YSIS<10:1,YSIS<15:2,YSIS<20:3,YSIS<25:4,YSIS<29:5,1:6)
QUIT
P37 SET N=N+$SELECT(YSIS<11:0,YSIS<21:1,YSIS<36:2,1:3)
QUIT
T79 SET N=N+$SELECT(YSIS>79:0,YSIS>70:1,YSIS>60:2,1:3)
QUIT
T80 SET N=N+$SELECT(YSIS>80:0,YSIS>69:1,1:2)
QUIT
T82 SET N=N+$SELECT(YSIS>79:0,YSIS>69:1,YSIS>59:2,YSIS>54:3,1:4)
QUIT
