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

YTSMPI2H.m

Go to the documentation of this file.
  1. YTSMPI2H ;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 HIGHER-ORDER (H-O) and RESTRUCTURED CLINICAL (RC) SCALES
  1. ;
  1. ;Scale^RawScore^TScore^CountofAnsweredQuestiona
  1. ;
  1. SETSCR ;
  1. ;TScores --- From TSARR array, piece 3
  1. N SCALE,TS
  1. F SCALE="EID","THD","BXD","RCd","RC1","RC2","RC3","RC4","RC6","RC7","RC8","RC9" D
  1. .S TS=$P(TSARR(SCALE),U,3)
  1. .I SCALE="EID" S E=TS
  1. .I SCALE="THD" S T=TS
  1. .I SCALE="BXD" S B=TS
  1. .I SCALE="RCd" S RC=TS
  1. .I SCALE="RC1" S R1=TS
  1. .I SCALE="RC2" S R2=TS
  1. .I SCALE="RC3" S R3=TS
  1. .I SCALE="RC4" S R4=TS
  1. .I SCALE="RC6" S R6=TS
  1. .I SCALE="RC7" S R7=TS
  1. .I SCALE="RC8" S R8=TS
  1. .I SCALE="RC9" S R9=TS
  1. Q
  1. BLDGRPH ; draw Validity Scale graph
  1. N I,J,NUMBER,PCENT,TLINE,VALSP,SCLINE,SCALE,GRPH
  1. N E,T,B,RC,R1,R2,R3,R4,R6,R7,R8,R9
  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:88 S TLINE=TLINE_"_"
  1. .E F J=6:1:88 S TLINE=TLINE_" "
  1. .S $E(TLINE,27)=":"
  1. .S E=93,T=100,B=94,RC=86,R1=100,R2=99,R3=83
  1. .S R4=99,R6=100,R7=94,R8=100,R9=91
  1. .D DMINMX(I)
  1. .S E=30,T=39,B=32,RC=37,R1=36,(R2,R3,R4,R7)=34,R6=43,R8=39,R9=25
  1. .D DMINMX(I)
  1. .D SETSCR
  1. .D SETSTAR
  1. .I $L(TLINE)>89 S TLINE=$E(TLINE,1,89)
  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)<6 S NUMBER=" "_NUMBER
  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_L_SP1_L_SP1_L_SP1_L_SP1_L_SP1_L_SP1_L
  1. F SCALE="EID","THD","BXD","RCd","RC1","RC2","RC3","RC4","RC6","RC7","RC8","RC9" 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,6)
  1. Q
  1. ;
  1. DMINMX(I) ;
  1. N K1
  1. F K1=0:1:3 D
  1. .I (I*4+(20-K1))=E D ; EID
  1. ..S $E(TLINE,9,11)="---"
  1. .I (I*4+(20-K1))=T D ; THD
  1. ..S $E(TLINE,16,18)="---"
  1. .I (I*4+(20-K1))=B D ; BXD
  1. ..S $E(TLINE,21,23)="---"
  1. .I (I*4+(20-K1))=RC D ; RCd
  1. ..S $E(TLINE,30,32)="---"
  1. .I (I*4+(20-K1))=R1 D ; RC1
  1. ..S $E(TLINE,37,39)="---"
  1. .I (I*4+(20-K1))=R2 D ; RC2
  1. ..S $E(TLINE,44,46)="---"
  1. .I (I*4+(20-K1))=R3 D ; RC3
  1. ..S $E(TLINE,51,53)="---"
  1. .I (I*4+(20-K1))=R4 D ; RC4
  1. ..S $E(TLINE,58,60)="---"
  1. .I (I*4+(20-K1))=R6 D ; RC6
  1. ..S $E(TLINE,65,67)="---"
  1. .I (I*4+(20-K1))=R7 D ; RC7
  1. ..S $E(TLINE,72,74)="---"
  1. .I (I*4+(20-K1))=R8 D ; RC8
  1. ..S $E(TLINE,79,81)="---"
  1. .I (I*4+(20-K1))=R9 D ; RC9
  1. ..S $E(TLINE,86,88)="---"
  1. Q
  1. SETSTAR ;
  1. N K1
  1. F K1=0:1:3 D
  1. .I (I*4+(20-K1))=E D ; EID
  1. ..S $E(TLINE,10)="*"
  1. .I (I*4+(20-K1))=T D ; THD
  1. ..S $E(TLINE,17)="*"
  1. .I (I*4+(20-K1))=B D ; BXD
  1. ..S $E(TLINE,23)="*"
  1. .I (I*4+(20-K1))=RC D ;RCd
  1. ..S $E(TLINE,31)="*"
  1. .I (I*4+(20-K1))=R1 D ; RC1
  1. ..S $E(TLINE,38)="*"
  1. .I (I*4+(20-K1))=R2 D ; RC2
  1. ..S $E(TLINE,45)="*"
  1. .I (I*4+(20-K1))=R3 D ; RC3
  1. ..S $E(TLINE,52)="*"
  1. .I (I*4+(20-K1))=R4 D ; RC4
  1. ..S $E(TLINE,59)="*"
  1. .I (I*4+(20-K1))=R6 D ; RC6
  1. ..S $E(TLINE,66)="*"
  1. .I (I*4+(20-K1))=R7 D ; RC7
  1. ..S $E(TLINE,73)="*"
  1. .I (I*4+(20-K1))=R8 D ; RC8
  1. ..S $E(TLINE,80)="*"
  1. .I (I*4+(20-K1))=R9 D ; RC9
  1. ..S $E(TLINE,87)="*"
  1. Q
  1. ;
  1. DSPSCOR ;
  1. N DATA,SCALE
  1. S TXT=TXT_"|"_$$ADDSP^YTSMPI2U("Raw ",9)
  1. F SCALE="EID","THD","BXD","RCd","RC1","RC2","RC3","RC4","RC6","RC7","RC8","RC9" D
  1. .S DATA=$$ADDSP^YTSMPI2U($P(TSARR(SCALE),U,2),7)
  1. .S TXT=TXT_DATA
  1. S TXT=TXT_"|"_$$ADDSP^YTSMPI2U("T Score ",9)
  1. F SCALE="EID","THD","BXD","RCd","RC1","RC2","RC3","RC4","RC6","RC7","RC8","RC9" D
  1. .S DATA=$$ADDSP^YTSMPI2U($P(TSARR(SCALE),U,3),7)
  1. .S TXT=TXT_DATA
  1. S TXT=TXT_"|"_$$ADDSP^YTSMPI2U("Resp % ",9)
  1. F SCALE="EID","THD","BXD","RCd","RC1","RC2","RC3","RC4","RC6","RC7","RC8","RC9" D
  1. .S DATA=$$ADDSP^YTSMPI2U($P(TSARR(SCALE),U,4),7)
  1. .S TXT=TXT_DATA
  1. Q
  1. ;
  1. HORCSC ;
  1. ;
  1. S TXT=TXT_"|| MMPI-2-RF HIGHER-ORDER (H-O) and RESTRUCTURED CLINICAL (RC) SCALES |"
  1. S TXT=TXT_"| Higher-Order Restructured Clinical"
  1. ;
  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_"||EID Emotional/Internalizing Dysfunction RCd Demoralization RC6 Ideas of Persecution"
  1. S TXT=TXT_"|THD Thought Dysfunction RC1 Somatic Complaints RC7 Dysfunctional Negative Emotions"
  1. S TXT=TXT_"|BXD Behavioral/Externalizing Dysfunction RC2 Low Positive Emotions RC8 Aberrant Experiences"
  1. S TXT=TXT_"| RC3 Cynicism RC9 Hypomanic Activation"
  1. S TXT=TXT_"| RC4 Antisocial Behavior"
  1. S TXT=TXT_"|***eop***"
  1. Q