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