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

YTSNEOP1.m

Go to the documentation of this file.
YTSNEOP1 ;SLC/PIJ - Score NEO-PI-3 ; 01/08/2016
 ;;5.01;MENTAL HEALTH;**123**;DEC 30,1994;Build 73
 ;
 ;Public, Supported ICRs
 ; #2056 - Fileman API - $$GET1^DIQ
 ;
 Q
 ;
SCORANS ;
 I (LEG="")!(LEG=" ")!(LEG=-1)!(LEG="X") D  Q
 .S SKIP=SKIP+1
 .; End of Skipped questions
 S TMPANS=LEG
 ; // N1
 I (DES=31)!(DES=91)!(DES=151)!(DES=211) D
 .D PROCANS^YTSNEOP3("N1",TMPANS,REGULAR)
 I (DES=1)!(DES=61)!(DES=121)!(DES=181) D
 .D PROCANS^YTSNEOP3("N1",TMPANS,REVERSE)
 ; // E1
 I (DES=2)!(DES=62)!(DES=122)!(DES=152)!(DES=182)!(DES=212) D
 .D PROCANS^YTSNEOP3("E1",TMPANS,REGULAR)
 I (DES=32)!(DES=92) D
 .D PROCANS^YTSNEOP3("E1",TMPANS,REVERSE)
 ; // O1
 I (DES=3)!(DES=63)!(DES=123) D
 .D PROCANS^YTSNEOP3("O1",TMPANS,REGULAR)
 I (DES=33)!(DES=93)!(DES=153)!(DES=183)!(DES=213) D
 .D PROCANS^YTSNEOP3("O1",TMPANS,REVERSE)
 ; // A1
 I (DES=34)!(DES=94)!(DES=154)!(DES=184)!(DES=214) D
 .D PROCANS^YTSNEOP3("A1",TMPANS,REGULAR)
 I (DES=4)!(DES=64)!(DES=124) D
 .D PROCANS^YTSNEOP3("A1",TMPANS,REVERSE)
 ; // C1
 I (DES=5)!(DES=65)!(DES=125)!(DES=185)!(DES=215) D
 .D PROCANS^YTSNEOP3("C1",TMPANS,REGULAR)
 I (DES=35)!(DES=95)!(DES=155) D
 .D PROCANS^YTSNEOP3("C1",TMPANS,REVERSE)
 ; // N2
 I (DES=6)!(DES=66)!(DES=126)!(DES=186)!(DES=216) D
 .D PROCANS^YTSNEOP3("N2",TMPANS,REGULAR)
 I (DES=36)!(DES=96)!(DES=156) D
 .D PROCANS^YTSNEOP3("N2",TMPANS,REVERSE)
 ; // E2
 I (DES=37)!(DES=97)!(DES=157)!(DES=217) D
 .D PROCANS^YTSNEOP3("E2",TMPANS,REGULAR)
 I (DES=7)!(DES=67)!(DES=127)!(DES=187) D
 .D PROCANS^YTSNEOP3("E2",TMPANS,REVERSE)
 ; // O2
 I (DES=38)!(DES=98)!(DES=158)!(DES=188)!(DES=218) D
 .D PROCANS^YTSNEOP3("O2",TMPANS,REGULAR)
 I (DES=8)!(DES=68)!(DES=128) D
 .D PROCANS^YTSNEOP3("O2",TMPANS,REVERSE)
 ; // A2
 I (DES=9)!(DES=69)!(DES=129) D
 .D PROCANS^YTSNEOP3("A2",TMPANS,REGULAR)
 I (DES=39)!(DES=99)!(DES=159)!(DES=189)!(DES=219) D
 .D PROCANS^YTSNEOP3("A2",TMPANS,REVERSE)
 ; // C2
 I (DES=40)!(DES=100)!(DES=160) D
 .D PROCANS^YTSNEOP3("C2",TMPANS,REGULAR)
 I (DES=10)!(DES=70)!(DES=130)!(DES=190)!(DES=220) D
 .D PROCANS^YTSNEOP3("C2",TMPANS,REVERSE)
 ; // N3
 I (DES=41)!(DES=101)!(DES=131)!(DES=161)!(DES=191)!(DES=221) D
 .D PROCANS^YTSNEOP3("N3",TMPANS,REGULAR)
 I (DES=11)!(DES=71) D
 .D PROCANS^YTSNEOP3("N3",TMPANS,REVERSE)
 ; // E3
 I (DES=12)!(DES=72)!(DES=132)!(DES=192) D
 .D PROCANS^YTSNEOP3("E3",TMPANS,REGULAR)
 I (DES=42)!(DES=102)!(DES=162)!(DES=222) D
 .D PROCANS^YTSNEOP3("E3",TMPANS,REVERSE)
 ; // O3
 I (DES=13)!(DES=73)!(DES=133)!(DES=193)!(DES=223) D
 .D PROCANS^YTSNEOP3("O3",TMPANS,REGULAR)
 I (DES=43)!(DES=103)!(DES=163) D
 .D PROCANS^YTSNEOP3("O3",TMPANS,REVERSE)
 ; // A3
 I (DES=44)!(DES=104)!(DES=164)!(DES=194)!(DES=224) D
 .D PROCANS^YTSNEOP3("A3",TMPANS,REGULAR)
 I (DES=14)!(DES=74)!(DES=134) D
 .D PROCANS^YTSNEOP3("A3",TMPANS,REVERSE)
 ; // C3
 I (DES=15)!(DES=75)!(DES=135)!(DES=165)!(DES=195)!(DES=225) D
 .D PROCANS^YTSNEOP3("C3",TMPANS,REGULAR)
 I (DES=45)!(DES=105) D
 .D PROCANS^YTSNEOP3("C3",TMPANS,REVERSE)
 ; // N4
 I (DES=16)!(DES=76)!(DES=136)!(DES=196)!(DES=226) D
 .D PROCANS^YTSNEOP3("N4",TMPANS,REGULAR)
 I (DES=46)!(DES=106)!(DES=166) D
 .D PROCANS^YTSNEOP3("N4",TMPANS,REVERSE)
 ; // E4
 I (DES=47)!(DES=107)!(DES=167)!(DES=197)!(DES=227) D
 .D PROCANS^YTSNEOP3("E4",TMPANS,REGULAR)
 I (DES=17)!(DES=77)!(DES=137) D
 .D PROCANS^YTSNEOP3("E4",TMPANS,REVERSE)
 ;  // O4
 I (DES=48)!(DES=108)!(DES=168) D
 .D PROCANS^YTSNEOP3("O4",TMPANS,REGULAR)
 I (DES=18)!(DES=78)!(DES=138)!(DES=198)!(DES=228) D
 .D PROCANS^YTSNEOP3("O4",TMPANS,REVERSE)
 ;  // A4
 I (DES=19)!(DES=79)!(DES=139) D
 .D PROCANS^YTSNEOP3("A4",TMPANS,REGULAR)
 I (DES=49)!(DES=109)!(DES=169)!(DES=199)!(DES=229) D
 .D PROCANS^YTSNEOP3("A4",TMPANS,REVERSE)
 ;  // C4
 I (DES=50)!(DES=110)!(DES=170)!(DES=200)!(DES=230) D
 .D PROCANS^YTSNEOP3("C4",TMPANS,REGULAR)
 I (DES=20)!(DES=80)!(DES=140) D
 .D PROCANS^YTSNEOP3("C4",TMPANS,REVERSE)
 ;  // N5
 I (DES=51)!(DES=111)!(DES=171)!(DES=201) D
 .D PROCANS^YTSNEOP3("N5",TMPANS,REGULAR)
 I (DES=21)!(DES=81)!(DES=141)!(DES=231) D
 .D PROCANS^YTSNEOP3("N5",TMPANS,REVERSE)
 ;  // E5
 I (DES=22)!(DES=82)!(DES=142)!(DES=172)!(DES=202)!(DES=232) D
 .D PROCANS^YTSNEOP3("E5",TMPANS,REGULAR)
 I (DES=52)!(DES=112) D
 .D PROCANS^YTSNEOP3("E5",TMPANS,REVERSE)
 ;  // O5
 I (DES=23)!(DES=83)!(DES=143)!(DES=203)!(DES=233) D
 .D PROCANS^YTSNEOP3("O5",TMPANS,REGULAR)
 I (DES=53)!(DES=113)!(DES=173) D
 .D PROCANS^YTSNEOP3("O5",TMPANS,REVERSE)
 ;  // A5
 I (DES=54)!(DES=114)!(DES=174)!(DES=204) D
 .D PROCANS^YTSNEOP3("A5",TMPANS,REGULAR)
 I (DES=24)!(DES=84)!(DES=144)!(DES=234) D
 .D PROCANS^YTSNEOP3("A5",TMPANS,REVERSE)
 ;  // C5
 I (DES=25)!(DES=85)!(DES=145)!(DES=235) D
 .D PROCANS^YTSNEOP3("C5",TMPANS,REGULAR)
 I (DES=55)!(DES=115)!(DES=175)!(DES=205) D
 .D PROCANS^YTSNEOP3("C5",TMPANS,REVERSE)
 ;  // N6
 I (DES=26)!(DES=86)!(DES=146) D
 .D PROCANS^YTSNEOP3("N6",TMPANS,REGULAR)
 I (DES=56)!(DES=116)!(DES=176)!(DES=206)!(DES=236) D
 .D PROCANS^YTSNEOP3("N6",TMPANS,REVERSE)
 ;  // E6
 I (DES=57)!(DES=117)!(DES=177)!(DES=237)  D
 .D PROCANS^YTSNEOP3("E6",TMPANS,REGULAR)
 I (DES=27)!(DES=87)!(DES=147)!(DES=207) D
 .D PROCANS^YTSNEOP3("E6",TMPANS,REVERSE)
 ;  // O6
 I (DES=58)!(DES=118)!(DES=178) D
 .D PROCANS^YTSNEOP3("O6",TMPANS,REGULAR)
 I (DES=28)!(DES=88)!(DES=148)!(DES=208)!(DES=238) D
 .D PROCANS^YTSNEOP3("O6",TMPANS,REVERSE)
 ;  // A6
 I (DES=29)!(DES=89)!(DES=149)!(DES=179)!(DES=209)!(DES=239) D
 .D PROCANS^YTSNEOP3("A6",TMPANS,REGULAR)
 I (DES=59)!(DES=119) D
 .D PROCANS^YTSNEOP3("A6",TMPANS,REVERSE)
 ;  // C6
 I (DES=60)!(DES=120)!(DES=180)!(DES=210)!(DES=240) D
 .D PROCANS^YTSNEOP3("C6",TMPANS,REGULAR)
 I (DES=30)!(DES=90)!(DES=150) D
 .D PROCANS^YTSNEOP3("C6",TMPANS,REVERSE)
 ;  // THREE validity questions
 I (DES=243) D  ; Question 'A'
 .S VA=TMPANS
 I (DES=244) D  ; Question 'B'
 .S VB=TMPANS
 I (DES=245) D  ; Question 'C'
 .S VC=TMPANS
 Q
 ; 
GETTSCOR(SCALE,RAW) ;
 ; T-score range 20-80.
 ; Formula:  t = New Mean (50) + New SD (10) * (SCALE Mean - RAW Score) / SCALE SD
 ; SCALE Mean and SCALE SD are for combined male & female norms.
 ; See page 114 in manual for values.
 N RESULT
 S RESULT=-1
 I RAW=-1 Q RESULT
 ; if too many skipped questions, set SCALE to NA
 I SKIP>40 Q "NA"
 ;
 I SCALE="N1" S RESULT=100-(50+(10*((15.7-RAW)/5.6)))
 I SCALE="N2" S RESULT=100-(50+(10*((13.6-RAW)/4.7)))
 I SCALE="N3" S RESULT=100-(50+(10*((13.3-RAW)/5.5)))
 I SCALE="N4" S RESULT=100-(50+(10*((13.4-RAW)/5.0)))
 I SCALE="N5" S RESULT=100-(50+(10*((15.7-RAW)/4.2)))
 I SCALE="N6" S RESULT=100-(50+(10*((11.1-RAW)/4.3)))
 ;
 I SCALE="E1" S RESULT=100-(50+(10*((22.3-RAW)/4.4)))
 I SCALE="E2" S RESULT=100-(50+(10*((17.1-RAW)/5.1)))
 I SCALE="E3" S RESULT=100-(50+(10*((16.1-RAW)/4.9)))
 I SCALE="E4" S RESULT=100-(50+(10*((17.7-RAW)/4.3)))
 I SCALE="E5" S RESULT=100-(50+(10*((17.2-RAW)/5.1)))
 I SCALE="E6" S RESULT=100-(50+(10*((20.2-RAW)/4.9)))
 ;
 I SCALE="O1" S RESULT=100-(50+(10*((17.1-RAW)/4.6)))
 I SCALE="O2" S RESULT=100-(50+(10*((16.4-RAW)/5.7)))
 I SCALE="O3" S RESULT=100-(50+(10*((20.4-RAW)/4.1)))
 I SCALE="O4" S RESULT=100-(50+(10*((15.9-RAW)/3.6)))
 I SCALE="O5" S RESULT=100-(50+(10*((17.8-RAW)/5.4)))
 I SCALE="O6" S RESULT=100-(50+(10*((20.1-RAW)/4.2)))
 ;
 I SCALE="A1" S RESULT=100-(50+(10*((19.5-RAW)/4.5)))
 I SCALE="A2" S RESULT=100-(50+(10*((20.3-RAW)/4.7)))
 I SCALE="A3" S RESULT=100-(50+(10*((23.4-RAW)/3.9)))
 I SCALE="A4" S RESULT=100-(50+(10*((16.4-RAW)/4.5)))
 I SCALE="A5" S RESULT=100-(50+(10*((19.1-RAW)/4.4)))
 I SCALE="A6" S RESULT=100-(50+(10*((20.4-RAW)/3.9)))
 ;
 I SCALE="C1" S RESULT=100-(50+(10*((21.4-RAW)/3.8)))
 I SCALE="C2" S RESULT=100-(50+(10*((19.3-RAW)/5.0)))
 I SCALE="C3" S RESULT=100-(50+(10*((22.3-RAW)/4.0)))
 I SCALE="C4" S RESULT=100-(50+(10*((19.6-RAW)/4.5)))
 I SCALE="C5" S RESULT=100-(50+(10*((20.5-RAW)/4.6)))
 I SCALE="C6" S RESULT=100-(50+(10*((17.9-RAW)/4.5)))
 ;
 ;This was in original Delphi code, it appears that max of 80, min of 20 is used
 ;for graphing and not displaying actual scores, therefore, removed logic 
 ;I RESULT=-1 Q RESULT
 ;I RESULT>80 S RESULT=80
 ;I RESULT<20 S RESULT=20
 Q RESULT
 ;
GETRTEXT(TSCORE) ; Get Range Score
 N X
 S X=""
 I TSCORE=-1 Q X
 I TSCORE>65 D
 .S X="Very High"
 I (TSCORE<=65),(TSCORE>55) D
 .S X="High"
 I (TSCORE<=55),(TSCORE>=45) D
 .S X="Average"
 I (TSCORE<45),(TSCORE>35) D
 .S X="Low"
 I (TSCORE<=35) D
 .S X="Very Low"
 Q X