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