- 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 23, 2025@18:32:04 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
