YTSMPI2H ;SLC/LLH - Score MMPI-2-RF ; 01/08/2016
;;5.01;MENTAL HEALTH;**123**;DEC 30,1994;Build 73
;
;Public, Supported ICRs
; #2056 - Fileman API - $$GET1^DIQ
;
Q
; MMPI-2-RF HIGHER-ORDER (H-O) and RESTRUCTURED CLINICAL (RC) SCALES
;
;Scale^RawScore^TScore^CountofAnsweredQuestiona
;
SETSCR ;
;TScores --- From TSARR array, piece 3
N SCALE,TS
F SCALE="EID","THD","BXD","RCd","RC1","RC2","RC3","RC4","RC6","RC7","RC8","RC9" D
.S TS=$P(TSARR(SCALE),U,3)
.I SCALE="EID" S E=TS
.I SCALE="THD" S T=TS
.I SCALE="BXD" S B=TS
.I SCALE="RCd" S RC=TS
.I SCALE="RC1" S R1=TS
.I SCALE="RC2" S R2=TS
.I SCALE="RC3" S R3=TS
.I SCALE="RC4" S R4=TS
.I SCALE="RC6" S R6=TS
.I SCALE="RC7" S R7=TS
.I SCALE="RC8" S R8=TS
.I SCALE="RC9" S R9=TS
Q
BLDGRPH ; draw Validity Scale graph
N I,J,NUMBER,PCENT,TLINE,VALSP,SCLINE,SCALE,GRPH
N E,T,B,RC,R1,R2,R3,R4,R6,R7,R8,R9
S GRPH=""
D SETVAR
F I=25:-1:0 S TLINE="",NUMBER="" D
.I (I#5)=0 D NUM
.I (I#5)'=0 S NUMBER=NUMBER_" :"
.S TLINE=NUMBER
.I (I=12)!(I=8)!(I=5)!(I=0) D
..F J=6:1:88 S TLINE=TLINE_"_"
.E F J=6:1:88 S TLINE=TLINE_" "
.S $E(TLINE,27)=":"
.S E=93,T=100,B=94,RC=86,R1=100,R2=99,R3=83
.S R4=99,R6=100,R7=94,R8=100,R9=91
.D DMINMX(I)
.S E=30,T=39,B=32,RC=37,R1=36,(R2,R3,R4,R7)=34,R6=43,R8=39,R9=25
.D DMINMX(I)
.D SETSCR
.D SETSTAR
.I $L(TLINE)>89 S TLINE=$E(TLINE,1,89)
.S GRPH=GRPH_"|"_TLINE
S TXT=TXT_GRPH
S TXT=TXT_VALSP_"|"_SCLINE_"|"
Q
NUM ;
S NUMBER=((I*4)+20)_"-:"
;I $L(NUMBER)<6 S NUMBER=" "_NUMBER
I $L(NUMBER)<5 S NUMBER=" "_NUMBER
Q
SETVAR ;
N SC,SP1,L
S PCENT=0,SCALE="",TLINE=" ",SCLINE=" "
S SP1=" ",L=":"
S VALSP="| "_SP1_L_SP1_L_SP1_L_SP1_L_SP1_L_SP1_L_SP1_L_SP1_L_SP1_L_SP1_L_SP1_L_SP1_L
F SCALE="EID","THD","BXD","RCd","RC1","RC2","RC3","RC4","RC6","RC7","RC8","RC9" D
.S SC=SCALE,PCENT=$P(TSARR(SCALE),U,4) I PCENT<90 S SC="*"_SC
.I $L(SC)<3 S SC=$$ADDSP^YTSMPI2U(SC,3)
.S SCLINE=SCLINE_$$PAD^YTSMPI2U(SC,6)
Q
;
DMINMX(I) ;
N K1
F K1=0:1:3 D
.I (I*4+(20-K1))=E D ; EID
..S $E(TLINE,9,11)="---"
.I (I*4+(20-K1))=T D ; THD
..S $E(TLINE,16,18)="---"
.I (I*4+(20-K1))=B D ; BXD
..S $E(TLINE,21,23)="---"
.I (I*4+(20-K1))=RC D ; RCd
..S $E(TLINE,30,32)="---"
.I (I*4+(20-K1))=R1 D ; RC1
..S $E(TLINE,37,39)="---"
.I (I*4+(20-K1))=R2 D ; RC2
..S $E(TLINE,44,46)="---"
.I (I*4+(20-K1))=R3 D ; RC3
..S $E(TLINE,51,53)="---"
.I (I*4+(20-K1))=R4 D ; RC4
..S $E(TLINE,58,60)="---"
.I (I*4+(20-K1))=R6 D ; RC6
..S $E(TLINE,65,67)="---"
.I (I*4+(20-K1))=R7 D ; RC7
..S $E(TLINE,72,74)="---"
.I (I*4+(20-K1))=R8 D ; RC8
..S $E(TLINE,79,81)="---"
.I (I*4+(20-K1))=R9 D ; RC9
..S $E(TLINE,86,88)="---"
Q
SETSTAR ;
N K1
F K1=0:1:3 D
.I (I*4+(20-K1))=E D ; EID
..S $E(TLINE,10)="*"
.I (I*4+(20-K1))=T D ; THD
..S $E(TLINE,17)="*"
.I (I*4+(20-K1))=B D ; BXD
..S $E(TLINE,23)="*"
.I (I*4+(20-K1))=RC D ;RCd
..S $E(TLINE,31)="*"
.I (I*4+(20-K1))=R1 D ; RC1
..S $E(TLINE,38)="*"
.I (I*4+(20-K1))=R2 D ; RC2
..S $E(TLINE,45)="*"
.I (I*4+(20-K1))=R3 D ; RC3
..S $E(TLINE,52)="*"
.I (I*4+(20-K1))=R4 D ; RC4
..S $E(TLINE,59)="*"
.I (I*4+(20-K1))=R6 D ; RC6
..S $E(TLINE,66)="*"
.I (I*4+(20-K1))=R7 D ; RC7
..S $E(TLINE,73)="*"
.I (I*4+(20-K1))=R8 D ; RC8
..S $E(TLINE,80)="*"
.I (I*4+(20-K1))=R9 D ; RC9
..S $E(TLINE,87)="*"
Q
;
DSPSCOR ;
N DATA,SCALE
S TXT=TXT_"|"_$$ADDSP^YTSMPI2U("Raw ",9)
F SCALE="EID","THD","BXD","RCd","RC1","RC2","RC3","RC4","RC6","RC7","RC8","RC9" D
.S DATA=$$ADDSP^YTSMPI2U($P(TSARR(SCALE),U,2),7)
.S TXT=TXT_DATA
S TXT=TXT_"|"_$$ADDSP^YTSMPI2U("T Score ",9)
F SCALE="EID","THD","BXD","RCd","RC1","RC2","RC3","RC4","RC6","RC7","RC8","RC9" D
.S DATA=$$ADDSP^YTSMPI2U($P(TSARR(SCALE),U,3),7)
.S TXT=TXT_DATA
S TXT=TXT_"|"_$$ADDSP^YTSMPI2U("Resp % ",9)
F SCALE="EID","THD","BXD","RCd","RC1","RC2","RC3","RC4","RC6","RC7","RC8","RC9" D
.S DATA=$$ADDSP^YTSMPI2U($P(TSARR(SCALE),U,4),7)
.S TXT=TXT_DATA
Q
;
HORCSC ;
;
S TXT=TXT_"|| MMPI-2-RF HIGHER-ORDER (H-O) and RESTRUCTURED CLINICAL (RC) SCALES |"
S TXT=TXT_"| Higher-Order Restructured Clinical"
;
;build graph/chart
D BLDGRPH
;display Raw, T Score, and % answered
D DSPSCOR
S TXT=TXT_"|"_FNOTE
S TXT=TXT_"||EID Emotional/Internalizing Dysfunction RCd Demoralization RC6 Ideas of Persecution"
S TXT=TXT_"|THD Thought Dysfunction RC1 Somatic Complaints RC7 Dysfunctional Negative Emotions"
S TXT=TXT_"|BXD Behavioral/Externalizing Dysfunction RC2 Low Positive Emotions RC8 Aberrant Experiences"
S TXT=TXT_"| RC3 Cynicism RC9 Hypomanic Activation"
S TXT=TXT_"| RC4 Antisocial Behavior"
S TXT=TXT_"|***eop***"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTSMPI2H 4969 printed Nov 22, 2024@17:30:15 Page 2
YTSMPI2H ;SLC/LLH - Score MMPI-2-RF ; 01/08/2016
+1 ;;5.01;MENTAL HEALTH;**123**;DEC 30,1994;Build 73
+2 ;
+3 ;Public, Supported ICRs
+4 ; #2056 - Fileman API - $$GET1^DIQ
+5 ;
+6 QUIT
+7 ; MMPI-2-RF HIGHER-ORDER (H-O) and RESTRUCTURED CLINICAL (RC) SCALES
+8 ;
+9 ;Scale^RawScore^TScore^CountofAnsweredQuestiona
+10 ;
SETSCR ;
+1 ;TScores --- From TSARR array, piece 3
+2 NEW SCALE,TS
+3 FOR SCALE="EID","THD","BXD","RCd","RC1","RC2","RC3","RC4","RC6","RC7","RC8","RC9"
Begin DoDot:1
+4 SET TS=$PIECE(TSARR(SCALE),U,3)
+5 IF SCALE="EID"
SET E=TS
+6 IF SCALE="THD"
SET T=TS
+7 IF SCALE="BXD"
SET B=TS
+8 IF SCALE="RCd"
SET RC=TS
+9 IF SCALE="RC1"
SET R1=TS
+10 IF SCALE="RC2"
SET R2=TS
+11 IF SCALE="RC3"
SET R3=TS
+12 IF SCALE="RC4"
SET R4=TS
+13 IF SCALE="RC6"
SET R6=TS
+14 IF SCALE="RC7"
SET R7=TS
+15 IF SCALE="RC8"
SET R8=TS
+16 IF SCALE="RC9"
SET R9=TS
End DoDot:1
+17 QUIT
BLDGRPH ; draw Validity Scale graph
+1 NEW I,J,NUMBER,PCENT,TLINE,VALSP,SCLINE,SCALE,GRPH
+2 NEW E,T,B,RC,R1,R2,R3,R4,R6,R7,R8,R9
+3 SET GRPH=""
+4 DO SETVAR
+5 FOR I=25:-1:0
SET TLINE=""
SET NUMBER=""
Begin DoDot:1
+6 IF (I#5)=0
DO NUM
+7 IF (I#5)'=0
SET NUMBER=NUMBER_" :"
+8 SET TLINE=NUMBER
+9 IF (I=12)!(I=8)!(I=5)!(I=0)
Begin DoDot:2
+10 FOR J=6:1:88
SET TLINE=TLINE_"_"
End DoDot:2
+11 IF '$TEST
FOR J=6:1:88
SET TLINE=TLINE_" "
+12 SET $EXTRACT(TLINE,27)=":"
+13 SET E=93
SET T=100
SET B=94
SET RC=86
SET R1=100
SET R2=99
SET R3=83
+14 SET R4=99
SET R6=100
SET R7=94
SET R8=100
SET R9=91
+15 DO DMINMX(I)
+16 SET E=30
SET T=39
SET B=32
SET RC=37
SET R1=36
SET (R2,R3,R4,R7)=34
SET R6=43
SET R8=39
SET R9=25
+17 DO DMINMX(I)
+18 DO SETSCR
+19 DO SETSTAR
+20 IF $LENGTH(TLINE)>89
SET TLINE=$EXTRACT(TLINE,1,89)
+21 SET GRPH=GRPH_"|"_TLINE
End DoDot:1
+22 SET TXT=TXT_GRPH
+23 SET TXT=TXT_VALSP_"|"_SCLINE_"|"
+24 QUIT
NUM ;
+1 SET NUMBER=((I*4)+20)_"-:"
+2 ;I $L(NUMBER)<6 S NUMBER=" "_NUMBER
+3 IF $LENGTH(NUMBER)<5
SET NUMBER=" "_NUMBER
+4 QUIT
SETVAR ;
+1 NEW SC,SP1,L
+2 SET PCENT=0
SET SCALE=""
SET TLINE=" "
SET SCLINE=" "
+3 SET SP1=" "
SET L=":"
+4 SET VALSP="| "_SP1_L_SP1_L_SP1_L_SP1_L_SP1_L_SP1_L_SP1_L_SP1_L_SP1_L_SP1_L_SP1_L_SP1_L
+5 FOR SCALE="EID","THD","BXD","RCd","RC1","RC2","RC3","RC4","RC6","RC7","RC8","RC9"
Begin DoDot:1
+6 SET SC=SCALE
SET PCENT=$PIECE(TSARR(SCALE),U,4)
IF PCENT<90
SET SC="*"_SC
+7 IF $LENGTH(SC)<3
SET SC=$$ADDSP^YTSMPI2U(SC,3)
+8 SET SCLINE=SCLINE_$$PAD^YTSMPI2U(SC,6)
End DoDot:1
+9 QUIT
+10 ;
DMINMX(I) ;
+1 NEW K1
+2 FOR K1=0:1:3
Begin DoDot:1
+3 ; EID
IF (I*4+(20-K1))=E
Begin DoDot:2
+4 SET $EXTRACT(TLINE,9,11)="---"
End DoDot:2
+5 ; THD
IF (I*4+(20-K1))=T
Begin DoDot:2
+6 SET $EXTRACT(TLINE,16,18)="---"
End DoDot:2
+7 ; BXD
IF (I*4+(20-K1))=B
Begin DoDot:2
+8 SET $EXTRACT(TLINE,21,23)="---"
End DoDot:2
+9 ; RCd
IF (I*4+(20-K1))=RC
Begin DoDot:2
+10 SET $EXTRACT(TLINE,30,32)="---"
End DoDot:2
+11 ; RC1
IF (I*4+(20-K1))=R1
Begin DoDot:2
+12 SET $EXTRACT(TLINE,37,39)="---"
End DoDot:2
+13 ; RC2
IF (I*4+(20-K1))=R2
Begin DoDot:2
+14 SET $EXTRACT(TLINE,44,46)="---"
End DoDot:2
+15 ; RC3
IF (I*4+(20-K1))=R3
Begin DoDot:2
+16 SET $EXTRACT(TLINE,51,53)="---"
End DoDot:2
+17 ; RC4
IF (I*4+(20-K1))=R4
Begin DoDot:2
+18 SET $EXTRACT(TLINE,58,60)="---"
End DoDot:2
+19 ; RC6
IF (I*4+(20-K1))=R6
Begin DoDot:2
+20 SET $EXTRACT(TLINE,65,67)="---"
End DoDot:2
+21 ; RC7
IF (I*4+(20-K1))=R7
Begin DoDot:2
+22 SET $EXTRACT(TLINE,72,74)="---"
End DoDot:2
+23 ; RC8
IF (I*4+(20-K1))=R8
Begin DoDot:2
+24 SET $EXTRACT(TLINE,79,81)="---"
End DoDot:2
+25 ; RC9
IF (I*4+(20-K1))=R9
Begin DoDot:2
+26 SET $EXTRACT(TLINE,86,88)="---"
End DoDot:2
End DoDot:1
+27 QUIT
SETSTAR ;
+1 NEW K1
+2 FOR K1=0:1:3
Begin DoDot:1
+3 ; EID
IF (I*4+(20-K1))=E
Begin DoDot:2
+4 SET $EXTRACT(TLINE,10)="*"
End DoDot:2
+5 ; THD
IF (I*4+(20-K1))=T
Begin DoDot:2
+6 SET $EXTRACT(TLINE,17)="*"
End DoDot:2
+7 ; BXD
IF (I*4+(20-K1))=B
Begin DoDot:2
+8 SET $EXTRACT(TLINE,23)="*"
End DoDot:2
+9 ;RCd
IF (I*4+(20-K1))=RC
Begin DoDot:2
+10 SET $EXTRACT(TLINE,31)="*"
End DoDot:2
+11 ; RC1
IF (I*4+(20-K1))=R1
Begin DoDot:2
+12 SET $EXTRACT(TLINE,38)="*"
End DoDot:2
+13 ; RC2
IF (I*4+(20-K1))=R2
Begin DoDot:2
+14 SET $EXTRACT(TLINE,45)="*"
End DoDot:2
+15 ; RC3
IF (I*4+(20-K1))=R3
Begin DoDot:2
+16 SET $EXTRACT(TLINE,52)="*"
End DoDot:2
+17 ; RC4
IF (I*4+(20-K1))=R4
Begin DoDot:2
+18 SET $EXTRACT(TLINE,59)="*"
End DoDot:2
+19 ; RC6
IF (I*4+(20-K1))=R6
Begin DoDot:2
+20 SET $EXTRACT(TLINE,66)="*"
End DoDot:2
+21 ; RC7
IF (I*4+(20-K1))=R7
Begin DoDot:2
+22 SET $EXTRACT(TLINE,73)="*"
End DoDot:2
+23 ; RC8
IF (I*4+(20-K1))=R8
Begin DoDot:2
+24 SET $EXTRACT(TLINE,80)="*"
End DoDot:2
+25 ; RC9
IF (I*4+(20-K1))=R9
Begin DoDot:2
+26 SET $EXTRACT(TLINE,87)="*"
End DoDot:2
End DoDot:1
+27 QUIT
+28 ;
DSPSCOR ;
+1 NEW DATA,SCALE
+2 SET TXT=TXT_"|"_$$ADDSP^YTSMPI2U("Raw ",9)
+3 FOR SCALE="EID","THD","BXD","RCd","RC1","RC2","RC3","RC4","RC6","RC7","RC8","RC9"
Begin DoDot:1
+4 SET DATA=$$ADDSP^YTSMPI2U($PIECE(TSARR(SCALE),U,2),7)
+5 SET TXT=TXT_DATA
End DoDot:1
+6 SET TXT=TXT_"|"_$$ADDSP^YTSMPI2U("T Score ",9)
+7 FOR SCALE="EID","THD","BXD","RCd","RC1","RC2","RC3","RC4","RC6","RC7","RC8","RC9"
Begin DoDot:1
+8 SET DATA=$$ADDSP^YTSMPI2U($PIECE(TSARR(SCALE),U,3),7)
+9 SET TXT=TXT_DATA
End DoDot:1
+10 SET TXT=TXT_"|"_$$ADDSP^YTSMPI2U("Resp % ",9)
+11 FOR SCALE="EID","THD","BXD","RCd","RC1","RC2","RC3","RC4","RC6","RC7","RC8","RC9"
Begin DoDot:1
+12 SET DATA=$$ADDSP^YTSMPI2U($PIECE(TSARR(SCALE),U,4),7)
+13 SET TXT=TXT_DATA
End DoDot:1
+14 QUIT
+15 ;
HORCSC ;
+1 ;
+2 SET TXT=TXT_"|| MMPI-2-RF HIGHER-ORDER (H-O) and RESTRUCTURED CLINICAL (RC) SCALES |"
+3 SET TXT=TXT_"| Higher-Order Restructured Clinical"
+4 ;
+5 ;build graph/chart
+6 DO BLDGRPH
+7 ;display Raw, T Score, and % answered
+8 DO DSPSCOR
+9 SET TXT=TXT_"|"_FNOTE
+10 SET TXT=TXT_"||EID Emotional/Internalizing Dysfunction RCd Demoralization RC6 Ideas of Persecution"
+11 SET TXT=TXT_"|THD Thought Dysfunction RC1 Somatic Complaints RC7 Dysfunctional Negative Emotions"
+12 SET TXT=TXT_"|BXD Behavioral/Externalizing Dysfunction RC2 Low Positive Emotions RC8 Aberrant Experiences"
+13 SET TXT=TXT_"| RC3 Cynicism RC9 Hypomanic Activation"
+14 SET TXT=TXT_"| RC4 Antisocial Behavior"
+15 SET TXT=TXT_"|***eop***"
+16 QUIT
