- 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 Feb 18, 2025@23:46:33 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