Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: YTSMPI2Y

YTSMPI2Y.m

Go to the documentation of this file.
  1. YTSMPI2Y ;SLC/LLH - Score MMPI-2-RF ; 01/08/2016
  1. ;;5.01;MENTAL HEALTH;**123**;DEC 30,1994;Build 73
  1. ;
  1. ;Public, Supported ICRs
  1. ; #2056 - Fileman API - $$GET1^DIQ
  1. ;
  1. Q
  1. ; MMPI-2-RF SOMATIC/COGNITIVE and INTERNALIZING SCALES
  1. ;
  1. ;Scale^RawScore^TScore^CountofAnsweredQuestiona
  1. SETSCR ;
  1. ;TScores --- From TSARR array, piece 3
  1. N SCALE,TS
  1. F SCALE="AGGR","PSYC","DISC","NEGE","INTR" D
  1. .S TS=$P(TSARR(SCALE),U,3)
  1. .I SCALE="AGGR" S AG=TS
  1. .I SCALE="PSYC" S PS=TS
  1. .I SCALE="DISC" S DI=TS
  1. .I SCALE="NEGE" S NE=TS
  1. .I SCALE="INTR" S IN=TS
  1. Q
  1. BLDGRPH ; draw Validity Scale graph
  1. N I,J,NUMBER,PCENT,TLINE,VALSP,SCLINE,SCALE,GRPH
  1. N AG,PS,DI,NE,IN
  1. S GRPH=""
  1. D SETVAR
  1. F I=25:-1:0 S TLINE="",NUMBER="" D
  1. .I (I#5)=0 D NUM
  1. .I (I#5)'=0 S NUMBER=NUMBER_" :"
  1. .S TLINE=NUMBER
  1. .I (I=12)!(I=8)!(I=5)!(I=0) D
  1. ..F J=6:1:52 S TLINE=TLINE_"_"
  1. .E F J=6:1:52 S TLINE=TLINE_" "
  1. .S AG=88,PS=100,DI=92,NE=95,IN=93
  1. .D DMINMX(I)
  1. .S AG=28,PS=38,DI=31,NE=32,IN=32
  1. .D DMINMX(I)
  1. .D SETSCR
  1. .D SETSTAR
  1. .I $L(TLINE)>52 S TLINE=$E(TLINE,1,52)
  1. .S GRPH=GRPH_"|"_TLINE
  1. S TXT=TXT_GRPH
  1. S TXT=TXT_VALSP_"|"_SCLINE_"|"
  1. Q
  1. NUM ;
  1. S NUMBER=((I*4)+20)_"-:"
  1. I $L(NUMBER)<5 S NUMBER=" "_NUMBER
  1. Q
  1. SETVAR ;
  1. N SC,SP1,L
  1. S PCENT=0,SCALE="",TLINE=" ",SCLINE=" "
  1. S SP1=" ",L=":"
  1. S VALSP="| "_SP1_L_SP1_L_SP1_L_SP1_L_SP1_L_SP1
  1. F SCALE="AGGR","PSYC","DISC","NEGE","INTR" D
  1. .S SC=SCALE,PCENT=$P(TSARR(SCALE),U,4) I PCENT<90 S SC="*"_SC
  1. .I $L(SC)<3 S SC=$$ADDSP^YTSMPI2U(SC,3)
  1. .S SCLINE=SCLINE_$$PAD^YTSMPI2U(SC,7)
  1. Q
  1. ;
  1. DMINMX(I) ;
  1. N K1
  1. F K1=0:1:3 D
  1. .I (I*4+(20-K1))=AG D ; AGGR
  1. ..S $E(TLINE,10,12)="---"
  1. .I (I*4+(20-K1))=PS D ; PSYC
  1. ..S $E(TLINE,18,20)="---"
  1. .I (I*4+(20-K1))=DI D ; DISC
  1. ..S $E(TLINE,26,28)="---"
  1. .I (I*4+(20-K1))=NE D ; NEGE
  1. ..S $E(TLINE,35,37)="---"
  1. .I (I*4+(20-K1))=IN D ; INTR
  1. ..S $E(TLINE,43,45)="---"
  1. Q
  1. SETSTAR ;
  1. N K1
  1. F K1=0:1:3 D
  1. .I (I*4+(20-K1))=AG D ; AGGR
  1. ..S $E(TLINE,11)="*"
  1. .I (I*4+(20-K1))=PS D ; PSYC
  1. ..S $E(TLINE,19)="*"
  1. .I (I*4+(20-K1))=DI D ; DISC
  1. ..S $E(TLINE,27)="*"
  1. .I (I*4+(20-K1))=NE D ; NEGE
  1. ..S $E(TLINE,36)="*"
  1. .I (I*4+(20-K1))=IN D ; INTR
  1. ..S $E(TLINE,44)="*"
  1. Q
  1. ;
  1. DSPSCOR ;
  1. N DATA,SCALE
  1. S TXT=TXT_"|"_$$ADDSP^YTSMPI2U("Raw ",10)
  1. F SCALE="AGGR","PSYC","DISC","NEGE","INTR" D
  1. .S DATA=$$ADDSP^YTSMPI2U($P(TSARR(SCALE),U,2),8)
  1. .S TXT=TXT_DATA
  1. S TXT=TXT_"|"_$$ADDSP^YTSMPI2U("T Score ",10)
  1. F SCALE="AGGR","PSYC","DISC","NEGE","INTR" D
  1. .S DATA=$$ADDSP^YTSMPI2U($P(TSARR(SCALE),U,3),8)
  1. .S TXT=TXT_DATA
  1. S TXT=TXT_"|"_$$ADDSP^YTSMPI2U("Resp % ",10)
  1. F SCALE="AGGR","PSYC","DISC","NEGE","INTR" D
  1. .S DATA=$$ADDSP^YTSMPI2U($P(TSARR(SCALE),U,4),8)
  1. .S TXT=TXT_DATA
  1. Q
  1. ;
  1. PSYSC ;
  1. ;
  1. S TXT=TXT_"|| MMPI-2-RF PSY-5 SCALES"
  1. ;build graph/chart
  1. D BLDGRPH
  1. ;display Raw, T Score, and % answered
  1. D DSPSCOR
  1. S TXT=TXT_"|"_FNOTE
  1. S TXT=TXT_"||AGGR-r Aggressiveness-Revised"
  1. S TXT=TXT_"|PSYC-r Psychoticism-Revised"
  1. S TXT=TXT_"|DISC-r Disconstraint-Revised"
  1. S TXT=TXT_"|NEGE-r Negative Emotionality/Neuroticism-Revised"
  1. S TXT=TXT_"|INTR-r Introversion/Low Positive Emotionality-Revised"
  1. S TXT=TXT_"||***eop***"
  1. Q