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

YTSNEOPI.m

Go to the documentation of this file.
  1. YTSNEOPI ;SLC/PIJ - Score NEO-PI-3 ; 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. ;
  1. DATA1 ;
  1. S YSINSNAM=$P($G(YSDATA(2)),U,3)
  1. I $G(YSINSNAM)="" S YSINSNAM=$G(YS("CODE"),"NO NAME PASSED")
  1. S NODE=2 F S NODE=$O(YSDATA(NODE)) Q:NODE="" D ; Start at YSDATA(3)
  1. .S DATA=YSDATA(NODE)
  1. .S YSQN=$P(DATA,U,1)
  1. .S YSCDA=$P($G(DATA),U,3) ; Choice ID
  1. .D DESGNTR^YTSCORE(YSQN,.DES)
  1. .;
  1. .;The Legacy Value (field #4 in file 601.75) cannot be used as 2 of the CHOICES are "mapped"
  1. .;to incorrect values:
  1. .; 782: Disagree = 3 and should be 2
  1. .; 785: Strongly agree = 6 and should be 5
  1. .;Additionally, the Legacy Value is the item number response and should be reduced by 1, i.e.
  1. .;Strongly Disagree = 1 and is scored as a 0, unless reverse scored.
  1. .;
  1. .I YSCDA=241 S LEG=0 ; Yes
  1. .I YSCDA=237 S LEG=1 ; No
  1. .;
  1. .I YSCDA=780 S LEG=0 ; Strongly disagree
  1. .I YSCDA=782 S LEG=1 ; Disagree
  1. .I YSCDA=999 S LEG=2 ; Neutral
  1. .I YSCDA=783 S LEG=3 ; Agree
  1. .I YSCDA=785 S LEG=4 ; Strongly agree
  1. .;using Question IEN
  1. .I YSQN=5963 S VA=LEG ; Question 'A'
  1. .I YSQN=5964 S VB=LEG ; Question 'B'
  1. .I YSQN=5965 S VC=LEG ; Question 'C'
  1. .; calculates the raw score for the non-domain scales, N1,N2...C5,C6 and counts skipped questions
  1. .D SCORANS^YTSNEOP1
  1. Q
  1. ;
  1. SCORESV ; For the Graph/Table
  1. I $D(^TMP($J,"YSG",1)),^TMP($J,"YSG",1)="[ERROR]" D Q ;-->out
  1. .K ^TMP($J,"YSCOR")
  1. .S ^TMP($J,"YSCOR",1)="[ERROR]"
  1. .S ^TMP($J,"YSCOR",2)=YSINSNAM_" Scale not found"
  1. ;
  1. K ^TMP($J,"YSCOR")
  1. S ^TMP($J,"YSCOR",1)="[DATA]"
  1. S ^TMP($J,"YSCOR",2)=$$GET1^DIQ(601.87,694_",",3,"I")_"="_$J(N,0,0)
  1. S ^TMP($J,"YSCOR",3)=$$GET1^DIQ(601.87,695_",",3,"I")_"="_$J(E,0,0)
  1. S ^TMP($J,"YSCOR",4)=$$GET1^DIQ(601.87,696_",",3,"I")_"="_$J(O,0,0)
  1. S ^TMP($J,"YSCOR",5)=$$GET1^DIQ(601.87,697_",",3,"I")_"="_$J(A,0,0)
  1. S ^TMP($J,"YSCOR",6)=$$GET1^DIQ(601.87,698_",",3,"I")_"="_$J(C,0,0)
  1. ; "N"
  1. S ^TMP($J,"YSCOR",7)=$$GET1^DIQ(601.87,642_",",3,"I")_"="_N1_U_$J($$GETTSCOR^YTSNEOP1("N1",N1),0,0)
  1. S ^TMP($J,"YSCOR",8)=$$GET1^DIQ(601.87,672_",",3,"I")_"="_N2_U_$J($$GETTSCOR^YTSNEOP1("N2",N2),0,0)
  1. S ^TMP($J,"YSCOR",9)=$$GET1^DIQ(601.87,674_",",3,"I")_"="_N3_U_$J($$GETTSCOR^YTSNEOP1("N3",N3),0,0)
  1. S ^TMP($J,"YSCOR",10)=$$GET1^DIQ(601.87,675_",",3,"I")_"="_N4_U_$J($$GETTSCOR^YTSNEOP1("N4",N4),0,0)
  1. S ^TMP($J,"YSCOR",11)=$$GET1^DIQ(601.87,691_",",3,"I")_"="_N5_U_$J($$GETTSCOR^YTSNEOP1("N5",N5),0,0)
  1. S ^TMP($J,"YSCOR",12)=$$GET1^DIQ(601.87,692_",",3,"I")_"="_N6_U_$J($$GETTSCOR^YTSNEOP1("N6",N6),0,0)
  1. ; "E"
  1. S ^TMP($J,"YSCOR",13)=$$GET1^DIQ(601.87,648_",",3,"I")_"="_E1_U_$J($$GETTSCOR^YTSNEOP1("E1",E1),0,0)
  1. S ^TMP($J,"YSCOR",14)=$$GET1^DIQ(601.87,677_",",3,"I")_"="_E2_U_$J($$GETTSCOR^YTSNEOP1("E2",E2),0,0)
  1. S ^TMP($J,"YSCOR",15)=$$GET1^DIQ(601.87,678_",",3,"I")_"="_E3_U_$J($$GETTSCOR^YTSNEOP1("E3",E3),0,0)
  1. S ^TMP($J,"YSCOR",16)=$$GET1^DIQ(601.87,679_",",3,"I")_"="_E4_U_$J($$GETTSCOR^YTSNEOP1("E4",E4),0,0)
  1. S ^TMP($J,"YSCOR",17)=$$GET1^DIQ(601.87,680_",",3,"I")_"="_E5_U_$J($$GETTSCOR^YTSNEOP1("E5",E5),0,0)
  1. S ^TMP($J,"YSCOR",18)=$$GET1^DIQ(601.87,681_",",3,"I")_"="_E6_U_$J($$GETTSCOR^YTSNEOP1("E6",E6),0,0)
  1. ; "O"
  1. S ^TMP($J,"YSCOR",19)=$$GET1^DIQ(601.87,654_",",3,"I")_"="_O1_U_$J($$GETTSCOR^YTSNEOP1("O1",O1),0,0)
  1. S ^TMP($J,"YSCOR",20)=$$GET1^DIQ(601.87,682_",",3,"I")_"="_O2_U_$J($$GETTSCOR^YTSNEOP1("O2",O2),0,0)
  1. S ^TMP($J,"YSCOR",21)=$$GET1^DIQ(601.87,683_",",3,"I")_"="_O3_U_$J($$GETTSCOR^YTSNEOP1("O3",O3),0,0)
  1. S ^TMP($J,"YSCOR",22)=$$GET1^DIQ(601.87,684_",",3,"I")_"="_O4_U_$J($$GETTSCOR^YTSNEOP1("O4",O4),0,0)
  1. S ^TMP($J,"YSCOR",23)=$$GET1^DIQ(601.87,685_",",3,"I")_"="_O5_U_$J($$GETTSCOR^YTSNEOP1("O5",O5),0,0)
  1. S ^TMP($J,"YSCOR",24)=$$GET1^DIQ(601.87,686_",",3,"I")_"="_O6_U_$J($$GETTSCOR^YTSNEOP1("O6",O6),0,0)
  1. ; "A"
  1. S ^TMP($J,"YSCOR",25)=$$GET1^DIQ(601.87,660_",",3,"I")_"="_A1_U_$J($$GETTSCOR^YTSNEOP1("A1",A1),0,0)
  1. S ^TMP($J,"YSCOR",26)=$$GET1^DIQ(601.87,687_",",3,"I")_"="_A2_U_$J($$GETTSCOR^YTSNEOP1("A2",A2),0,0)
  1. S ^TMP($J,"YSCOR",27)=$$GET1^DIQ(601.87,688_",",3,"I")_"="_A3_U_$J($$GETTSCOR^YTSNEOP1("A3",A3),0,0)
  1. S ^TMP($J,"YSCOR",28)=$$GET1^DIQ(601.87,689_",",3,"I")_"="_A4_U_$J($$GETTSCOR^YTSNEOP1("A4",A4),0,0)
  1. S ^TMP($J,"YSCOR",29)=$$GET1^DIQ(601.87,690_",",3,"I")_"="_A5_U_$J($$GETTSCOR^YTSNEOP1("A5",A5),0,0)
  1. S ^TMP($J,"YSCOR",30)=$$GET1^DIQ(601.87,693_",",3,"I")_"="_A6_U_$J($$GETTSCOR^YTSNEOP1("A6",A6),0,0)
  1. ; "C"
  1. S ^TMP($J,"YSCOR",31)=$$GET1^DIQ(601.87,666_",",3,"I")_"="_C1_U_$J($$GETTSCOR^YTSNEOP1("C1",C1),0,0)
  1. S ^TMP($J,"YSCOR",32)=$$GET1^DIQ(601.87,667_",",3,"I")_"="_C2_U_$J($$GETTSCOR^YTSNEOP1("C2",C2),0,0)
  1. S ^TMP($J,"YSCOR",33)=$$GET1^DIQ(601.87,668_",",3,"I")_"="_C3_U_$J($$GETTSCOR^YTSNEOP1("C3",C3),0,0)
  1. S ^TMP($J,"YSCOR",34)=$$GET1^DIQ(601.87,669_",",3,"I")_"="_C4_U_$J($$GETTSCOR^YTSNEOP1("C4",C4),0,0)
  1. S ^TMP($J,"YSCOR",35)=$$GET1^DIQ(601.87,670_",",3,"I")_"="_C5_U_$J($$GETTSCOR^YTSNEOP1("C5",C5),0,0)
  1. S ^TMP($J,"YSCOR",36)=$$GET1^DIQ(601.87,671_",",3,"I")_"="_C6_U_$J($$GETTSCOR^YTSNEOP1("C6",C6),0,0)
  1. Q
  1. ;
  1. DLLSTR(YSDATA,YS,YSTRNG) ;
  1. ; YSTRNG = 1 Score Instrument
  1. ; YSTRNG = 2 get Report Answers and Text
  1. N DATA,DES,NODE,LEG,SCORE,YSCDA,YSQN,YSINSNAM,TSARR
  1. N RAW,RESULT,SKIP,RSLT,RSLT1,SCALE,YSAD
  1. N ZERO,ONE,TWO,THREE,FOUR
  1. N TMPRSLT,TMPANS,VA,VB,VC,VR
  1. N REGULAR,REVERSE,REGREV,TSARR
  1. N V0,V1,V2,V3,V4
  1. N N,N1,N2,N3,N4,N5,N6
  1. N E,E1,E2,E3,E4,E5,E6
  1. N O,O1,O2,O3,O4,O5,O6
  1. N A,A1,A2,A3,A4,A5,A6
  1. N C,C1,C2,C3,C4,C5,C6
  1. ;
  1. S REVERSE="REVERSE"
  1. S REGULAR="REGULAR"
  1. ;
  1. S (TMPRSLT,TMPANS)=""
  1. S (N,N1,N2,N3,N4,N5,N6)=0
  1. S (E,E1,E2,E3,E4,E5,E6)=0
  1. S (O,O1,O2,O3,O4,O5,O6)=0
  1. S (A,A1,A2,A3,A4,A5,A6)=0
  1. S (C,C1,C2,C3,C4,C5,C6)=0
  1. S (V0,V1,V2,V3,V4)=0
  1. S (SKIP,ZERO,ONE,TWO,THREE,FOUR)=0
  1. S (VA,VB,VC,VR)=""
  1. ;
  1. S (RESULT,STRING)=""
  1. S (DES,RAW)=0
  1. ;
  1. D DATA1
  1. ;
  1. I YSTRNG=1 D
  1. .D SCORDOM^YTSNEOP3
  1. .D SCORESV
  1. ;
  1. I YSTRNG=2 D
  1. .K TSARR
  1. .S RSLT="",RSLT1="",TSARR("NOADM")=""
  1. .S YSAD=YS("AD")
  1. .; special subroutine to get both Raw and Transformed scores
  1. .D LDTSCOR^YTSCORE(.TSARR,YSAD)
  1. .I TSARR("NOADM")="" D
  1. ..D PROGNOTE^YTSNEOP2
  1. .S YSDATA($O(YSDATA(""),-1)+1)=999999999999_U_U_$S(TSARR("NOADM")'="":TSARR("NOADM"),1:RSLT)
  1. Q