YTSMPI2Y ;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 SOMATIC/COGNITIVE and INTERNALIZING SCALES
;
;Scale^RawScore^TScore^CountofAnsweredQuestiona
SETSCR ;
;TScores --- From TSARR array, piece 3
N SCALE,TS
F SCALE="AGGR","PSYC","DISC","NEGE","INTR" D
.S TS=$P(TSARR(SCALE),U,3)
.I SCALE="AGGR" S AG=TS
.I SCALE="PSYC" S PS=TS
.I SCALE="DISC" S DI=TS
.I SCALE="NEGE" S NE=TS
.I SCALE="INTR" S IN=TS
Q
BLDGRPH ; draw Validity Scale graph
N I,J,NUMBER,PCENT,TLINE,VALSP,SCLINE,SCALE,GRPH
N AG,PS,DI,NE,IN
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:52 S TLINE=TLINE_"_"
.E F J=6:1:52 S TLINE=TLINE_" "
.S AG=88,PS=100,DI=92,NE=95,IN=93
.D DMINMX(I)
.S AG=28,PS=38,DI=31,NE=32,IN=32
.D DMINMX(I)
.D SETSCR
.D SETSTAR
.I $L(TLINE)>52 S TLINE=$E(TLINE,1,52)
.S GRPH=GRPH_"|"_TLINE
S TXT=TXT_GRPH
S TXT=TXT_VALSP_"|"_SCLINE_"|"
Q
NUM ;
S NUMBER=((I*4)+20)_"-:"
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
F SCALE="AGGR","PSYC","DISC","NEGE","INTR" 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,7)
Q
;
DMINMX(I) ;
N K1
F K1=0:1:3 D
.I (I*4+(20-K1))=AG D ; AGGR
..S $E(TLINE,10,12)="---"
.I (I*4+(20-K1))=PS D ; PSYC
..S $E(TLINE,18,20)="---"
.I (I*4+(20-K1))=DI D ; DISC
..S $E(TLINE,26,28)="---"
.I (I*4+(20-K1))=NE D ; NEGE
..S $E(TLINE,35,37)="---"
.I (I*4+(20-K1))=IN D ; INTR
..S $E(TLINE,43,45)="---"
Q
SETSTAR ;
N K1
F K1=0:1:3 D
.I (I*4+(20-K1))=AG D ; AGGR
..S $E(TLINE,11)="*"
.I (I*4+(20-K1))=PS D ; PSYC
..S $E(TLINE,19)="*"
.I (I*4+(20-K1))=DI D ; DISC
..S $E(TLINE,27)="*"
.I (I*4+(20-K1))=NE D ; NEGE
..S $E(TLINE,36)="*"
.I (I*4+(20-K1))=IN D ; INTR
..S $E(TLINE,44)="*"
Q
;
DSPSCOR ;
N DATA,SCALE
S TXT=TXT_"|"_$$ADDSP^YTSMPI2U("Raw ",10)
F SCALE="AGGR","PSYC","DISC","NEGE","INTR" D
.S DATA=$$ADDSP^YTSMPI2U($P(TSARR(SCALE),U,2),8)
.S TXT=TXT_DATA
S TXT=TXT_"|"_$$ADDSP^YTSMPI2U("T Score ",10)
F SCALE="AGGR","PSYC","DISC","NEGE","INTR" D
.S DATA=$$ADDSP^YTSMPI2U($P(TSARR(SCALE),U,3),8)
.S TXT=TXT_DATA
S TXT=TXT_"|"_$$ADDSP^YTSMPI2U("Resp % ",10)
F SCALE="AGGR","PSYC","DISC","NEGE","INTR" D
.S DATA=$$ADDSP^YTSMPI2U($P(TSARR(SCALE),U,4),8)
.S TXT=TXT_DATA
Q
;
PSYSC ;
;
S TXT=TXT_"|| MMPI-2-RF PSY-5 SCALES"
;build graph/chart
D BLDGRPH
;display Raw, T Score, and % answered
D DSPSCOR
S TXT=TXT_"|"_FNOTE
S TXT=TXT_"||AGGR-r Aggressiveness-Revised"
S TXT=TXT_"|PSYC-r Psychoticism-Revised"
S TXT=TXT_"|DISC-r Disconstraint-Revised"
S TXT=TXT_"|NEGE-r Negative Emotionality/Neuroticism-Revised"
S TXT=TXT_"|INTR-r Introversion/Low Positive Emotionality-Revised"
S TXT=TXT_"||***eop***"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTSMPI2Y 3251 printed Nov 22, 2024@17:30:21 Page 2
YTSMPI2Y ;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 SOMATIC/COGNITIVE and INTERNALIZING SCALES
+8 ;
+9 ;Scale^RawScore^TScore^CountofAnsweredQuestiona
SETSCR ;
+1 ;TScores --- From TSARR array, piece 3
+2 NEW SCALE,TS
+3 FOR SCALE="AGGR","PSYC","DISC","NEGE","INTR"
Begin DoDot:1
+4 SET TS=$PIECE(TSARR(SCALE),U,3)
+5 IF SCALE="AGGR"
SET AG=TS
+6 IF SCALE="PSYC"
SET PS=TS
+7 IF SCALE="DISC"
SET DI=TS
+8 IF SCALE="NEGE"
SET NE=TS
+9 IF SCALE="INTR"
SET IN=TS
End DoDot:1
+10 QUIT
BLDGRPH ; draw Validity Scale graph
+1 NEW I,J,NUMBER,PCENT,TLINE,VALSP,SCLINE,SCALE,GRPH
+2 NEW AG,PS,DI,NE,IN
+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:52
SET TLINE=TLINE_"_"
End DoDot:2
+11 IF '$TEST
FOR J=6:1:52
SET TLINE=TLINE_" "
+12 SET AG=88
SET PS=100
SET DI=92
SET NE=95
SET IN=93
+13 DO DMINMX(I)
+14 SET AG=28
SET PS=38
SET DI=31
SET NE=32
SET IN=32
+15 DO DMINMX(I)
+16 DO SETSCR
+17 DO SETSTAR
+18 IF $LENGTH(TLINE)>52
SET TLINE=$EXTRACT(TLINE,1,52)
+19 SET GRPH=GRPH_"|"_TLINE
End DoDot:1
+20 SET TXT=TXT_GRPH
+21 SET TXT=TXT_VALSP_"|"_SCLINE_"|"
+22 QUIT
NUM ;
+1 SET NUMBER=((I*4)+20)_"-:"
+2 IF $LENGTH(NUMBER)<5
SET NUMBER=" "_NUMBER
+3 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
+5 FOR SCALE="AGGR","PSYC","DISC","NEGE","INTR"
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,7)
End DoDot:1
+9 QUIT
+10 ;
DMINMX(I) ;
+1 NEW K1
+2 FOR K1=0:1:3
Begin DoDot:1
+3 ; AGGR
IF (I*4+(20-K1))=AG
Begin DoDot:2
+4 SET $EXTRACT(TLINE,10,12)="---"
End DoDot:2
+5 ; PSYC
IF (I*4+(20-K1))=PS
Begin DoDot:2
+6 SET $EXTRACT(TLINE,18,20)="---"
End DoDot:2
+7 ; DISC
IF (I*4+(20-K1))=DI
Begin DoDot:2
+8 SET $EXTRACT(TLINE,26,28)="---"
End DoDot:2
+9 ; NEGE
IF (I*4+(20-K1))=NE
Begin DoDot:2
+10 SET $EXTRACT(TLINE,35,37)="---"
End DoDot:2
+11 ; INTR
IF (I*4+(20-K1))=IN
Begin DoDot:2
+12 SET $EXTRACT(TLINE,43,45)="---"
End DoDot:2
End DoDot:1
+13 QUIT
SETSTAR ;
+1 NEW K1
+2 FOR K1=0:1:3
Begin DoDot:1
+3 ; AGGR
IF (I*4+(20-K1))=AG
Begin DoDot:2
+4 SET $EXTRACT(TLINE,11)="*"
End DoDot:2
+5 ; PSYC
IF (I*4+(20-K1))=PS
Begin DoDot:2
+6 SET $EXTRACT(TLINE,19)="*"
End DoDot:2
+7 ; DISC
IF (I*4+(20-K1))=DI
Begin DoDot:2
+8 SET $EXTRACT(TLINE,27)="*"
End DoDot:2
+9 ; NEGE
IF (I*4+(20-K1))=NE
Begin DoDot:2
+10 SET $EXTRACT(TLINE,36)="*"
End DoDot:2
+11 ; INTR
IF (I*4+(20-K1))=IN
Begin DoDot:2
+12 SET $EXTRACT(TLINE,44)="*"
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
DSPSCOR ;
+1 NEW DATA,SCALE
+2 SET TXT=TXT_"|"_$$ADDSP^YTSMPI2U("Raw ",10)
+3 FOR SCALE="AGGR","PSYC","DISC","NEGE","INTR"
Begin DoDot:1
+4 SET DATA=$$ADDSP^YTSMPI2U($PIECE(TSARR(SCALE),U,2),8)
+5 SET TXT=TXT_DATA
End DoDot:1
+6 SET TXT=TXT_"|"_$$ADDSP^YTSMPI2U("T Score ",10)
+7 FOR SCALE="AGGR","PSYC","DISC","NEGE","INTR"
Begin DoDot:1
+8 SET DATA=$$ADDSP^YTSMPI2U($PIECE(TSARR(SCALE),U,3),8)
+9 SET TXT=TXT_DATA
End DoDot:1
+10 SET TXT=TXT_"|"_$$ADDSP^YTSMPI2U("Resp % ",10)
+11 FOR SCALE="AGGR","PSYC","DISC","NEGE","INTR"
Begin DoDot:1
+12 SET DATA=$$ADDSP^YTSMPI2U($PIECE(TSARR(SCALE),U,4),8)
+13 SET TXT=TXT_DATA
End DoDot:1
+14 QUIT
+15 ;
PSYSC ;
+1 ;
+2 SET TXT=TXT_"|| MMPI-2-RF PSY-5 SCALES"
+3 ;build graph/chart
+4 DO BLDGRPH
+5 ;display Raw, T Score, and % answered
+6 DO DSPSCOR
+7 SET TXT=TXT_"|"_FNOTE
+8 SET TXT=TXT_"||AGGR-r Aggressiveness-Revised"
+9 SET TXT=TXT_"|PSYC-r Psychoticism-Revised"
+10 SET TXT=TXT_"|DISC-r Disconstraint-Revised"
+11 SET TXT=TXT_"|NEGE-r Negative Emotionality/Neuroticism-Revised"
+12 SET TXT=TXT_"|INTR-r Introversion/Low Positive Emotionality-Revised"
+13 SET TXT=TXT_"||***eop***"
+14 QUIT
