YTSMPI2S ;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="MLS","GIC","HPC","NUC","COG","SUI","HLP","SFD","NFC","STW","AXY","ANP","BRF","MSF" D
.S TS=$P(TSARR(SCALE),U,3)
.I SCALE="MLS" S M=TS
.I SCALE="GIC" S G=TS
.I SCALE="HPC" S H=TS
.I SCALE="NUC" S N=TS
.I SCALE="COG" S C=TS
.I SCALE="SUI" S S=TS
.I SCALE="HLP" S HLP=TS
.I SCALE="SFD" S SFD=TS
.I SCALE="NFC" S NFC=TS
.I SCALE="STW" S STW=TS
.I SCALE="AXY" S A=TS
.I SCALE="ANP" S ANP=TS
.I SCALE="BRF" S B=TS
.I SCALE="MSF" S MSF=TS
Q
BLDGRPH ; draw Validity Scale graph
N I,J,NUMBER,PCENT,TLINE,VALSP,SCLINE,SCALE,GRPH
N M,G,H,N,C,S,HLP,SFD,NFC,STW,A,ANP,B,MSF
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:90 S TLINE=TLINE_"_"
.E F J=6:1:90 S TLINE=TLINE_" "
.S $E(TLINE,37)=":"
.S M=87,(G,C)=96,H=85,(N,S,A,B)=100,HLP=88,SFD=76,(NFC,ANP)=80,STW=81,MSF=78
.D DMINMX(I)
.S M=38,G=46,(H,SFD)=42,N=41,(C,HLP)=40,S=45,(NFC,STW,MSF)=36,A=44,ANP=39,B=43
.D DMINMX(I)
.D SETSCR
.D SETSTAR
.I $L(TLINE)>90 S TLINE=$E(TLINE,1,90)
.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 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_SP1_L_SP1_L
F SCALE="MLS","GIC","HPC","NUC","COG","SUI","HLP","SFD","NFC","STW","AXY","ANP","BRF","MSF" 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)
.S SCLINE=SCLINE_$$PAD^YTSMPI2U(SC,5)
Q
;
DMINMX(I) ;
N K1
F K1=0:1:3 D
.I (I*4+(20-K1))=M D ; MLS
..S $E(TLINE,9,11)="---"
.I (I*4+(20-K1))=G D ; GIC
..S $E(TLINE,15,17)="---"
.I (I*4+(20-K1))=H D ; HPC
..S $E(TLINE,21,23)="---"
.I (I*4+(20-K1))=N D ; NUC
..S $E(TLINE,27,29)="---"
.I (I*4+(20-K1))=C D ; COG
..S $E(TLINE,33,35)="---"
.I (I*4+(20-K1))=S D ; SUI
..S $E(TLINE,39,41)="---"
.I (I*4+(20-K1))=HLP D ; HLP
..S $E(TLINE,45,47)="---"
.I (I*4+(20-K1))=SFD D ; SFD
..S $E(TLINE,51,53)="---"
.I (I*4+(20-K1))=NFC D ; NFC
..S $E(TLINE,57,59)="---"
.I (I*4+(20-K1))=STW D ; STW
..S $E(TLINE,63,65)="---"
.I (I*4+(20-K1))=A D ; AXY
..S $E(TLINE,69,71)="---"
.I (I*4+(20-K1))=ANP D ; ANP
..S $E(TLINE,75,77)="---"
.I (I*4+(20-K1))=B D ; BRF
..S $E(TLINE,81,83)="---"
.I (I*4+(20-K1))=MSF D ; MSF
..S $E(TLINE,87,89)="---"
Q
;
SETSTAR ;
N K1
F K1=0:1:3 D
.I (I*4+(20-K1))=M D ; MLS
..S $E(TLINE,10)="*"
.I (I*4+(20-K1))=G D ; GIC
..S $E(TLINE,16)="*"
.I (I*4+(20-K1))=H D ; HPC
..S $E(TLINE,22)="*"
.I (I*4+(20-K1))=N D ; NUC
..S $E(TLINE,29)="*"
.I (I*4+(20-K1))=C D ; COG
..S $E(TLINE,34)="*"
.I (I*4+(20-K1))=S D ; SUI
..S $E(TLINE,40)="*"
.I (I*4+(20-K1))=HLP D ; HLP
..S $E(TLINE,46)="*"
.I (I*4+(20-K1))=SFD D ; SFD
..S $E(TLINE,52)="*"
.I (I*4+(20-K1))=NFC D ; NFC
..S $E(TLINE,58)="*"
.I (I*4+(20-K1))=STW D ; STW
..S $E(TLINE,64)="*"
.I (I*4+(20-K1))=A D ; AXY
..S $E(TLINE,70)="*"
.I (I*4+(20-K1))=ANP D ; ANP
..S $E(TLINE,76)="*"
.I (I*4+(20-K1))=B D ; BRF
..S $E(TLINE,82)="*"
.I (I*4+(20-K1))=MSF D ; MSF
..S $E(TLINE,88)="*"
Q
;
DSPSCOR ;
;
N DATA,SCALE
S TXT=TXT_"|"_$$ADDSP^YTSMPI2U("Raw ",8) ; was 9
F SCALE="MLS","GIC","HPC","NUC","COG","SUI","HLP","SFD","NFC","STW","AXY","ANP","BRF","MSF" D
.S DATA=$$ADDSP^YTSMPI2U($P(TSARR(SCALE),U,2),6) ; was 7
.S TXT=TXT_DATA
S TXT=TXT_"|"_$$ADDSP^YTSMPI2U("T Score ",8)
F SCALE="MLS","GIC","HPC","NUC","COG","SUI","HLP","SFD","NFC","STW","AXY","ANP","BRF","MSF" D
.S DATA=$$ADDSP^YTSMPI2U($P(TSARR(SCALE),U,3),6)
.S TXT=TXT_DATA
S TXT=TXT_"|"_$$ADDSP^YTSMPI2U("Resp % ",8)
F SCALE="MLS","GIC","HPC","NUC","COG","SUI","HLP","SFD","NFC","STW","AXY","ANP","BRF","MSF" D
.S DATA=$$ADDSP^YTSMPI2U($P(TSARR(SCALE),U,4),6)
.S TXT=TXT_DATA
Q
;
SOCOSC ;
;
S TXT=TXT_"|| MMPI-2-RF SOMATIC/COGNITIVE and INTERNALIZING SCALES |"
S TXT=TXT_"| Somatic/Cognitive Internalizing"
;build graph/chart
D BLDGRPH
;display Raw, T Score, and % answered
D DSPSCOR
S TXT=TXT_"|"_FNOTE
S TXT=TXT_"||MLS Malaise SUI Suicidal/Death Ideation AXY Anxiety"
S TXT=TXT_"|GIC Gastrointestinal Complaints HLP Helplessness/Hopelessness ANP Anger Proneness"
S TXT=TXT_"|HPC Head Pain Complaints SFD Self-Doubt BRF Behavior-Restricting Fears"
S TXT=TXT_"|NUC Neurological Complaints NFC Inefficacy MSF Multiple Specific Fear"
S TXT=TXT_"|COG Cognitive Complaints STW Stress/Worry"
S TXT=TXT_"||***eop***"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTSMPI2S 5315 printed Apr 09, 2024@21:18:31 Page 2
YTSMPI2S ;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="MLS","GIC","HPC","NUC","COG","SUI","HLP","SFD","NFC","STW","AXY","ANP","BRF","MSF"
Begin DoDot:1
+4 SET TS=$PIECE(TSARR(SCALE),U,3)
+5 IF SCALE="MLS"
SET M=TS
+6 IF SCALE="GIC"
SET G=TS
+7 IF SCALE="HPC"
SET H=TS
+8 IF SCALE="NUC"
SET N=TS
+9 IF SCALE="COG"
SET C=TS
+10 IF SCALE="SUI"
SET S=TS
+11 IF SCALE="HLP"
SET HLP=TS
+12 IF SCALE="SFD"
SET SFD=TS
+13 IF SCALE="NFC"
SET NFC=TS
+14 IF SCALE="STW"
SET STW=TS
+15 IF SCALE="AXY"
SET A=TS
+16 IF SCALE="ANP"
SET ANP=TS
+17 IF SCALE="BRF"
SET B=TS
+18 IF SCALE="MSF"
SET MSF=TS
End DoDot:1
+19 QUIT
BLDGRPH ; draw Validity Scale graph
+1 NEW I,J,NUMBER,PCENT,TLINE,VALSP,SCLINE,SCALE,GRPH
+2 NEW M,G,H,N,C,S,HLP,SFD,NFC,STW,A,ANP,B,MSF
+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:90
SET TLINE=TLINE_"_"
End DoDot:2
+11 IF '$TEST
FOR J=6:1:90
SET TLINE=TLINE_" "
+12 SET $EXTRACT(TLINE,37)=":"
+13 SET M=87
SET (G,C)=96
SET H=85
SET (N,S,A,B)=100
SET HLP=88
SET SFD=76
SET (NFC,ANP)=80
SET STW=81
SET MSF=78
+14 DO DMINMX(I)
+15 SET M=38
SET G=46
SET (H,SFD)=42
SET N=41
SET (C,HLP)=40
SET S=45
SET (NFC,STW,MSF)=36
SET A=44
SET ANP=39
SET B=43
+16 DO DMINMX(I)
+17 DO SETSCR
+18 DO SETSTAR
+19 IF $LENGTH(TLINE)>90
SET TLINE=$EXTRACT(TLINE,1,90)
+20 SET GRPH=GRPH_"|"_TLINE
End DoDot:1
+21 SET TXT=TXT_GRPH
+22 SET TXT=TXT_VALSP_"|"_SCLINE_"|"
+23 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 ;S SP1=" ",L=":"
+4 SET SP1=" "
SET L=":"
+5 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_SP1_L_SP1_L
+6 FOR SCALE="MLS","GIC","HPC","NUC","COG","SUI","HLP","SFD","NFC","STW","AXY","ANP","BRF","MSF"
Begin DoDot:1
+7 SET SC=SCALE
SET PCENT=$PIECE(TSARR(SCALE),U,4)
IF PCENT<90
SET SC="*"_SC
+8 IF $LENGTH(SC)<3
SET SC=$$ADDSP^YTSMPI2U(SC,3)
+9 ;S SCLINE=SCLINE_$$PAD^YTSMPI2U(SC,6)
+10 SET SCLINE=SCLINE_$$PAD^YTSMPI2U(SC,5)
End DoDot:1
+11 QUIT
+12 ;
DMINMX(I) ;
+1 NEW K1
+2 FOR K1=0:1:3
Begin DoDot:1
+3 ; MLS
IF (I*4+(20-K1))=M
Begin DoDot:2
+4 SET $EXTRACT(TLINE,9,11)="---"
End DoDot:2
+5 ; GIC
IF (I*4+(20-K1))=G
Begin DoDot:2
+6 SET $EXTRACT(TLINE,15,17)="---"
End DoDot:2
+7 ; HPC
IF (I*4+(20-K1))=H
Begin DoDot:2
+8 SET $EXTRACT(TLINE,21,23)="---"
End DoDot:2
+9 ; NUC
IF (I*4+(20-K1))=N
Begin DoDot:2
+10 SET $EXTRACT(TLINE,27,29)="---"
End DoDot:2
+11 ; COG
IF (I*4+(20-K1))=C
Begin DoDot:2
+12 SET $EXTRACT(TLINE,33,35)="---"
End DoDot:2
+13 ; SUI
IF (I*4+(20-K1))=S
Begin DoDot:2
+14 SET $EXTRACT(TLINE,39,41)="---"
End DoDot:2
+15 ; HLP
IF (I*4+(20-K1))=HLP
Begin DoDot:2
+16 SET $EXTRACT(TLINE,45,47)="---"
End DoDot:2
+17 ; SFD
IF (I*4+(20-K1))=SFD
Begin DoDot:2
+18 SET $EXTRACT(TLINE,51,53)="---"
End DoDot:2
+19 ; NFC
IF (I*4+(20-K1))=NFC
Begin DoDot:2
+20 SET $EXTRACT(TLINE,57,59)="---"
End DoDot:2
+21 ; STW
IF (I*4+(20-K1))=STW
Begin DoDot:2
+22 SET $EXTRACT(TLINE,63,65)="---"
End DoDot:2
+23 ; AXY
IF (I*4+(20-K1))=A
Begin DoDot:2
+24 SET $EXTRACT(TLINE,69,71)="---"
End DoDot:2
+25 ; ANP
IF (I*4+(20-K1))=ANP
Begin DoDot:2
+26 SET $EXTRACT(TLINE,75,77)="---"
End DoDot:2
+27 ; BRF
IF (I*4+(20-K1))=B
Begin DoDot:2
+28 SET $EXTRACT(TLINE,81,83)="---"
End DoDot:2
+29 ; MSF
IF (I*4+(20-K1))=MSF
Begin DoDot:2
+30 SET $EXTRACT(TLINE,87,89)="---"
End DoDot:2
End DoDot:1
+31 QUIT
+32 ;
SETSTAR ;
+1 NEW K1
+2 FOR K1=0:1:3
Begin DoDot:1
+3 ; MLS
IF (I*4+(20-K1))=M
Begin DoDot:2
+4 SET $EXTRACT(TLINE,10)="*"
End DoDot:2
+5 ; GIC
IF (I*4+(20-K1))=G
Begin DoDot:2
+6 SET $EXTRACT(TLINE,16)="*"
End DoDot:2
+7 ; HPC
IF (I*4+(20-K1))=H
Begin DoDot:2
+8 SET $EXTRACT(TLINE,22)="*"
End DoDot:2
+9 ; NUC
IF (I*4+(20-K1))=N
Begin DoDot:2
+10 SET $EXTRACT(TLINE,29)="*"
End DoDot:2
+11 ; COG
IF (I*4+(20-K1))=C
Begin DoDot:2
+12 SET $EXTRACT(TLINE,34)="*"
End DoDot:2
+13 ; SUI
IF (I*4+(20-K1))=S
Begin DoDot:2
+14 SET $EXTRACT(TLINE,40)="*"
End DoDot:2
+15 ; HLP
IF (I*4+(20-K1))=HLP
Begin DoDot:2
+16 SET $EXTRACT(TLINE,46)="*"
End DoDot:2
+17 ; SFD
IF (I*4+(20-K1))=SFD
Begin DoDot:2
+18 SET $EXTRACT(TLINE,52)="*"
End DoDot:2
+19 ; NFC
IF (I*4+(20-K1))=NFC
Begin DoDot:2
+20 SET $EXTRACT(TLINE,58)="*"
End DoDot:2
+21 ; STW
IF (I*4+(20-K1))=STW
Begin DoDot:2
+22 SET $EXTRACT(TLINE,64)="*"
End DoDot:2
+23 ; AXY
IF (I*4+(20-K1))=A
Begin DoDot:2
+24 SET $EXTRACT(TLINE,70)="*"
End DoDot:2
+25 ; ANP
IF (I*4+(20-K1))=ANP
Begin DoDot:2
+26 SET $EXTRACT(TLINE,76)="*"
End DoDot:2
+27 ; BRF
IF (I*4+(20-K1))=B
Begin DoDot:2
+28 SET $EXTRACT(TLINE,82)="*"
End DoDot:2
+29 ; MSF
IF (I*4+(20-K1))=MSF
Begin DoDot:2
+30 SET $EXTRACT(TLINE,88)="*"
End DoDot:2
End DoDot:1
+31 QUIT
+32 ;
DSPSCOR ;
+1 ;
+2 NEW DATA,SCALE
+3 ; was 9
SET TXT=TXT_"|"_$$ADDSP^YTSMPI2U("Raw ",8)
+4 FOR SCALE="MLS","GIC","HPC","NUC","COG","SUI","HLP","SFD","NFC","STW","AXY","ANP","BRF","MSF"
Begin DoDot:1
+5 ; was 7
SET DATA=$$ADDSP^YTSMPI2U($PIECE(TSARR(SCALE),U,2),6)
+6 SET TXT=TXT_DATA
End DoDot:1
+7 SET TXT=TXT_"|"_$$ADDSP^YTSMPI2U("T Score ",8)
+8 FOR SCALE="MLS","GIC","HPC","NUC","COG","SUI","HLP","SFD","NFC","STW","AXY","ANP","BRF","MSF"
Begin DoDot:1
+9 SET DATA=$$ADDSP^YTSMPI2U($PIECE(TSARR(SCALE),U,3),6)
+10 SET TXT=TXT_DATA
End DoDot:1
+11 SET TXT=TXT_"|"_$$ADDSP^YTSMPI2U("Resp % ",8)
+12 FOR SCALE="MLS","GIC","HPC","NUC","COG","SUI","HLP","SFD","NFC","STW","AXY","ANP","BRF","MSF"
Begin DoDot:1
+13 SET DATA=$$ADDSP^YTSMPI2U($PIECE(TSARR(SCALE),U,4),6)
+14 SET TXT=TXT_DATA
End DoDot:1
+15 QUIT
+16 ;
SOCOSC ;
+1 ;
+2 SET TXT=TXT_"|| MMPI-2-RF SOMATIC/COGNITIVE and INTERNALIZING SCALES |"
+3 SET TXT=TXT_"| Somatic/Cognitive Internalizing"
+4 ;build graph/chart
+5 DO BLDGRPH
+6 ;display Raw, T Score, and % answered
+7 DO DSPSCOR
+8 SET TXT=TXT_"|"_FNOTE
+9 SET TXT=TXT_"||MLS Malaise SUI Suicidal/Death Ideation AXY Anxiety"
+10 SET TXT=TXT_"|GIC Gastrointestinal Complaints HLP Helplessness/Hopelessness ANP Anger Proneness"
+11 SET TXT=TXT_"|HPC Head Pain Complaints SFD Self-Doubt BRF Behavior-Restricting Fears"
+12 SET TXT=TXT_"|NUC Neurological Complaints NFC Inefficacy MSF Multiple Specific Fear"
+13 SET TXT=TXT_"|COG Cognitive Complaints STW Stress/Worry"
+14 SET TXT=TXT_"||***eop***"
+15 QUIT
