YTSPROM ;SLC/MJB- Score PROMIS29 ; 10/14/18 2:02pm
;;5.01;MENTAL HEALTH;**151**;Dec 30, 1994;Build 92
;
; This routine was split from YTQAPI2A.
; This routine handles limited complex reporting requirements without
; modifying YS_AUX.DLL by adding free text "answers" that can be used by
; a report.
;,
; Assumptions: EDIT incomplete instrument should ignore the extra answers
; since there are no associated questions. GRAPHING should ignore the
; answers since they not numeric.
;
Q
;
DLLSTR(YSDATA,YS,YSTRNG) ;
;
N TOTAL,TXT,YSMED,YSOVER,YSTOTAL,YSCALEI,YSRSC,YSSCNAM,SLIDESC
N YSCAL,YSVAL,YSCALVI,YTSCOR,YSVALA,YSRSC1,YSRSC2,YSRSC3,YSRSC4,YSRSC5,YSRSC6,YSRSC7
N YSTSC1,YSTSC2,YSTSC3,YSTSC4,YSTSC5,YSTSC6,YSTSC7,II,PROM,YSCALIEN,YSSCNAM,YSTSC
S N=N+1,II=0
IF YSTRNG=1 D DATA1 D SCORESV
I YSTRNG=2 D
.;D SCORESV
.D LDSCORES(.YSDATA,.YS)
.D STRING
Q
;
SCORESV ;
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)=$G(YSINSNAM)_" Scale not found"
S YSSCNAM=$P($G(^TMP($J,"YSG",3)),U,4) ; Scale Name=$P($G(^TMP($J,"YSG",3)),U,4) ; Scale Name=$P($G(^TMP($J,"YSG",3)),U,4) ; Scale Name
;
K ^TMP($J,"YSCOR")
S ^TMP($J,"YSCOR",1)="[DATA]"
;this needs to be changed to the current instrument scale
S I=2
F S I=$O(^TMP($J,"YSG",I)) Q:'I D
.S YSCALIEN=$P($P(^TMP($J,"YSG",I),"^",1),"=",2)
.S YSRSC="YSRSC"_(I-2)
.S YSTSC="YSTSC"_(I-2)
.S ^TMP($J,"YSCOR",I)=$$GET1^DIQ(601.87,YSCALIEN_",",3,"I")_"="_@YSRSC_U_@YSTSC
Q
;
DATA1 ;
N I
S N=N+1,II=0
;D YSARRAY^YTQAPI2C(.PROM)
S I="",YSRSC1=0,YSRSC2=0,YSRSC3=0,YSRSC4=0,YSRSC5=0,YSRSC6=0,YSRSC7=0
F I=3:1:6 S YSRSC1=$$GET1^DIQ(601.75,$P(YSDATA(I),"^",3)_",",4,"I")+YSRSC1
F I=7:1:10 S YSRSC2=$$GET1^DIQ(601.75,$P(YSDATA(I),"^",3)_",",4,"I")+YSRSC2
F I=11:1:14 S YSRSC3=$$GET1^DIQ(601.75,$P(YSDATA(I),"^",3)_",",4,"I")+YSRSC3
F I=15:1:18 S YSRSC4=$$GET1^DIQ(601.75,$P(YSDATA(I),"^",3)_",",4,"I")+YSRSC4
F I=19:1:22 S YSRSC5=$$GET1^DIQ(601.75,$P(YSDATA(I),"^",3)_",",4,"I")+YSRSC5
F I=23:1:26 S YSRSC6=$$GET1^DIQ(601.75,$P(YSDATA(I),"^",3)_",",4,"I")+YSRSC6
F I=27:1:30 S YSRSC7=$$GET1^DIQ(601.75,$P(YSDATA(I),"^",3)_",",4,"I")+YSRSC7
S SLIDESC=$P(YSDATA(31),"^",3)
S YSTSC1=$$BRADJ1(YSRSC1)
S YSTSC2=$$BRADJ2(YSRSC2)
S YSTSC3=$$BRADJ3(YSRSC3)
S YSTSC4=$$BRADJ4(YSRSC4)
S YSTSC5=$$BRADJ5(YSRSC5)
S YSTSC6=$$BRADJ6(YSRSC6)
S YSTSC7=$$BRADJ7(YSRSC7)
Q
;
BRADJ1(YSRSC1) ;Adjust the Base Rate based on Scales - Physical Function
Q:YSRSC1=4 22.9
Q:YSRSC1=5 26.9
Q:YSRSC1=4 22.9
Q:YSRSC1=5 26.9
Q:YSRSC1=6 29.1
Q:YSRSC1=7 30.7
Q:YSRSC1=8 32.1
Q:YSRSC1=9 33.3
Q:YSRSC1=10 34.4
Q:YSRSC1=11 35.6
Q:YSRSC1=12 36.7
Q:YSRSC1=13 37.9
Q:YSRSC1=14 39.1
Q:YSRSC1=15 40.4
Q:YSRSC1=16 41.8
Q:YSRSC1=17 43.4
Q:YSRSC1=18 45.3
Q:YSRSC1=19 48.0
Q:YSRSC1=20 56.9
Q ""
;
BRADJ2(YSRSC2) ;Adjust the Base Rate based on Scales - Anxiety
Q:YSRSC2=4 40.3
Q:YSRSC2=5 48.0
Q:YSRSC2=6 51.2
Q:YSRSC2=7 53.7
Q:YSRSC2=8 55.8
Q:YSRSC2=9 57.7
Q:YSRSC2=10 59.5
Q:YSRSC2=11 61.4
Q:YSRSC2=12 63.4
Q:YSRSC2=13 65.3
Q:YSRSC2=14 67.3
Q:YSRSC2=15 69.3
Q:YSRSC2=16 71.2
Q:YSRSC2=17 73.3
Q:YSRSC2=18 75.4
Q:YSRSC2=19 77.9
Q:YSRSC2=20 81.6
Q ""
;
BRADJ3(YSRSC3) ;Adjust the Base Rate based on Scales - Depression
Q:YSRSC3=4 41.0
Q:YSRSC3=5 49.0
Q:YSRSC3=6 51.8
Q:YSRSC3=7 53.9
Q:YSRSC3=8 55.7
Q:YSRSC3=9 57.3
Q:YSRSC3=10 58.9
Q:YSRSC3=11 60.5
Q:YSRSC3=12 62.2
Q:YSRSC3=13 63.9
Q:YSRSC3=14 65.7
Q:YSRSC3=15 67.5
Q:YSRSC3=16 69.4
Q:YSRSC3=17 71.2
Q:YSRSC3=18 73.3
Q:YSRSC3=19 75.7
Q:YSRSC3=20 79.4
Q ""
;
BRADJ4(YSRSC4) ;Adjust the Base Rate based on Scales - Fatigue
Q:YSRSC4=4 33.7
Q:YSRSC4=5 39.7
Q:YSRSC4=6 43.1
Q:YSRSC4=7 46.0
Q:YSRSC4=8 48.6
Q:YSRSC4=9 51.0
Q:YSRSC4=10 53.1
Q:YSRSC4=11 55.1
Q:YSRSC4=12 57.0
Q:YSRSC4=13 58.8
Q:YSRSC4=14 60.7
Q:YSRSC4=15 62.7
Q:YSRSC4=16 64.6
Q:YSRSC4=17 66.7
Q:YSRSC4=18 69.0
Q:YSRSC4=19 71.6
Q:YSRSC4=20 75.8
Q ""
;
BRADJ5(YSRSC5) ;Adjust the Base Rate based on Scales - Sleep Disturbance
Q:YSRSC5=4 32.0
Q:YSRSC5=5 37.5
Q:YSRSC5=6 41.1
Q:YSRSC5=7 43.8
Q:YSRSC5=8 46.2
Q:YSRSC5=9 48.4
Q:YSRSC5=10 50.5
Q:YSRSC5=11 52.4
Q:YSRSC5=12 54.3
Q:YSRSC5=13 56.1
Q:YSRSC5=14 57.9
Q:YSRSC5=15 59.8
Q:YSRSC5=16 61.7
Q:YSRSC5=17 63.8
Q:YSRSC5=18 66.0
Q:YSRSC5=19 68.8
Q:YSRSC5=20 73.3
Q ""
;
BRADJ6(YSRSC6) ;Adjust the Base Rate based on Scales - Satisfaction with Social Role
Q:YSRSC6=4 27.5
Q:YSRSC6=5 31.8
Q:YSRSC6=6 34.0
Q:YSRSC6=7 35.7
Q:YSRSC6=8 37.3
Q:YSRSC6=9 38.8
Q:YSRSC6=10 40.5
Q:YSRSC6=11 42.3
Q:YSRSC6=12 44.2
Q:YSRSC6=13 46.2
Q:YSRSC6=14 48.1
Q:YSRSC6=15 50.0
Q:YSRSC6=16 51.9
Q:YSRSC6=17 53.7
Q:YSRSC6=18 55.8
Q:YSRSC6=19 58.3
Q:YSRSC6=20 64.2
Q ""
;
BRADJ7(YSRSC7) ;Adjust the Base Rate based on Scales - Pain Interference
Q:YSRSC7=4 41.6
Q:YSRSC7=5 49.6
Q:YSRSC7=6 52.0
Q:YSRSC7=7 53.9
Q:YSRSC7=8 55.6
Q:YSRSC7=9 57.1
Q:YSRSC7=10 58.5
Q:YSRSC7=11 59.9
Q:YSRSC7=12 61.2
Q:YSRSC7=13 52.5
Q:YSRSC7=14 63.8
Q:YSRSC7=15 65.2
Q:YSRSC7=16 66.6
Q:YSRSC7=17 68.0
Q:YSRSC7=18 69.7
Q:YSRSC7=19 71.6
Q:YSRSC7=20 75.6
Q ""
;
PAD(VAL,LENGTH) ; padds the value with spaces at beginning
N RETURN,PADDING
I VAL="Left blank by the user." S VAL="--"
S PADDING=LENGTH-$L(VAL)
I PADDING'>0 Q VAL
S $P(RETURN," ",PADDING+1)=VAL
Q RETURN
;
STRING ;
S YSRSC1=$P($G(^TMP($J,"YSCOR",2)),"=",2),YSRSC1=$P(YSRSC1,U,1)
S YSTSC1=$P($G(^TMP($J,"YSCOR",2)),U,2)
S YSRSC2=$P($G(^TMP($J,"YSCOR",3)),"=",2),YSRSC2=$P(YSRSC2,U,1)
S YSTSC2=$P($G(^TMP($J,"YSCOR",3)),U,2)
S YSRSC3=$P($G(^TMP($J,"YSCOR",4)),"=",2),YSRSC3=$P(YSRSC3,U,1)
S YSTSC3=$P($G(^TMP($J,"YSCOR",4)),U,2)
S YSRSC4=$P($G(^TMP($J,"YSCOR",5)),"=",2),YSRSC4=$P(YSRSC4,U,1)
S YSTSC4=$P($G(^TMP($J,"YSCOR",5)),U,2)
S YSRSC5=$P($G(^TMP($J,"YSCOR",6)),"=",2),YSRSC5=$P(YSRSC5,U,1)
S YSTSC5=$P($G(^TMP($J,"YSCOR",6)),U,2)
S YSRSC6=$P($G(^TMP($J,"YSCOR",7)),"=",2),YSRSC6=$P(YSRSC6,U,1)
S YSTSC6=$P($G(^TMP($J,"YSCOR",7)),U,2)
S YSRSC7=$P($G(^TMP($J,"YSCOR",8)),"=",2),YSRSC7=$P(YSRSC7,U,1)
S YSTSC7=$P($G(^TMP($J,"YSCOR",8)),U,2)
S YSDATA(N)="7771^9999;1^"_$$PAD(YSRSC1,2) S N=N+1
S YSDATA(N)="7772^9999;1^"_$$PAD(YSRSC2,2) S N=N+1
S YSDATA(N)="7773^9999;1^"_$$PAD(YSRSC3,2) S N=N+1
S YSDATA(N)="7774^9999;1^"_$$PAD(YSRSC4,2) S N=N+1
S YSDATA(N)="7775^9999;1^"_$$PAD(YSRSC5,2) S N=N+1
S YSDATA(N)="7776^9999;1^"_$$PAD(YSRSC6,2) S N=N+1
S YSDATA(N)="7777^9999;1^"_$$PAD(YSRSC7,2) S N=N+1
S YSDATA(N)="7778^9999;1^"_YSTSC1 S N=N+1
S YSDATA(N)="7779^9999;1^"_YSTSC2 S N=N+1
S YSDATA(N)="7780^9999;1^"_YSTSC3 S N=N+1
S YSDATA(N)="7781^9999;1^"_YSTSC4 S N=N+1
S YSDATA(N)="7782^9999;1^"_YSTSC5 S N=N+1
S YSDATA(N)="7783^9999;1^"_YSTSC6 S N=N+1
S YSDATA(N)="7784^9999;1^"_YSTSC7 S N=N+1
Q
;
LDSCORES(YSDATA,YS) ; new call for patch 123 using to get T-scores
;input:AD = ADMINISTRATION #
;output: [DATA]
N G,N,IEN71,SCALE,YSAD,YSCODEN,YSCALE
S YSAD=$G(YS("AD"))
;
S YSDATA=$NA(^TMP($J,"YSCOR"))
S ^TMP($J,"YSCOR",1)="[DATA]",N=1
;
S YSCALE="",N=1
F S YSCALE=$O(^YTT(601.92,"AC",YSAD,YSCALE)) Q:'YSCALE D
.S G=$G(^YTT(601.92,YSCALE,0))
.S SCALE=$P(G,U,3),N=N+1
.S ^TMP($J,"YSCOR",N)=SCALE_"="_$P(G,U,4,7)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTSPROM 7500 printed Sep 23, 2025@19:56:46 Page 2
YTSPROM ;SLC/MJB- Score PROMIS29 ; 10/14/18 2:02pm
+1 ;;5.01;MENTAL HEALTH;**151**;Dec 30, 1994;Build 92
+2 ;
+3 ; This routine was split from YTQAPI2A.
+4 ; This routine handles limited complex reporting requirements without
+5 ; modifying YS_AUX.DLL by adding free text "answers" that can be used by
+6 ; a report.
+7 ;,
+8 ; Assumptions: EDIT incomplete instrument should ignore the extra answers
+9 ; since there are no associated questions. GRAPHING should ignore the
+10 ; answers since they not numeric.
+11 ;
+12 QUIT
+13 ;
DLLSTR(YSDATA,YS,YSTRNG) ;
+1 ;
+2 NEW TOTAL,TXT,YSMED,YSOVER,YSTOTAL,YSCALEI,YSRSC,YSSCNAM,SLIDESC
+3 NEW YSCAL,YSVAL,YSCALVI,YTSCOR,YSVALA,YSRSC1,YSRSC2,YSRSC3,YSRSC4,YSRSC5,YSRSC6,YSRSC7
+4 NEW YSTSC1,YSTSC2,YSTSC3,YSTSC4,YSTSC5,YSTSC6,YSTSC7,II,PROM,YSCALIEN,YSSCNAM,YSTSC
+5 SET N=N+1
SET II=0
+6 IF YSTRNG=1
DO DATA1
DO SCORESV
+7 IF YSTRNG=2
Begin DoDot:1
+8 ;D SCORESV
+9 DO LDSCORES(.YSDATA,.YS)
+10 DO STRING
End DoDot:1
+11 QUIT
+12 ;
SCORESV ;
+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)=$GET(YSINSNAM)_" Scale not found"
End DoDot:1
QUIT
+5 ; Scale Name=$P($G(^TMP($J,"YSG",3)),U,4) ; Scale Name=$P($G(^TMP($J,"YSG",3)),U,4) ; Scale Name
SET YSSCNAM=$PIECE($GET(^TMP($JOB,"YSG",3)),U,4)
+6 ;
+7 KILL ^TMP($JOB,"YSCOR")
+8 SET ^TMP($JOB,"YSCOR",1)="[DATA]"
+9 ;this needs to be changed to the current instrument scale
+10 SET I=2
+11 FOR
SET I=$ORDER(^TMP($JOB,"YSG",I))
if 'I
QUIT
Begin DoDot:1
+12 SET YSCALIEN=$PIECE($PIECE(^TMP($JOB,"YSG",I),"^",1),"=",2)
+13 SET YSRSC="YSRSC"_(I-2)
+14 SET YSTSC="YSTSC"_(I-2)
+15 SET ^TMP($JOB,"YSCOR",I)=$$GET1^DIQ(601.87,YSCALIEN_",",3,"I")_"="_@YSRSC_U_@YSTSC
End DoDot:1
+16 QUIT
+17 ;
DATA1 ;
+1 NEW I
+2 SET N=N+1
SET II=0
+3 ;D YSARRAY^YTQAPI2C(.PROM)
+4 SET I=""
SET YSRSC1=0
SET YSRSC2=0
SET YSRSC3=0
SET YSRSC4=0
SET YSRSC5=0
SET YSRSC6=0
SET YSRSC7=0
+5 FOR I=3:1:6
SET YSRSC1=$$GET1^DIQ(601.75,$PIECE(YSDATA(I),"^",3)_",",4,"I")+YSRSC1
+6 FOR I=7:1:10
SET YSRSC2=$$GET1^DIQ(601.75,$PIECE(YSDATA(I),"^",3)_",",4,"I")+YSRSC2
+7 FOR I=11:1:14
SET YSRSC3=$$GET1^DIQ(601.75,$PIECE(YSDATA(I),"^",3)_",",4,"I")+YSRSC3
+8 FOR I=15:1:18
SET YSRSC4=$$GET1^DIQ(601.75,$PIECE(YSDATA(I),"^",3)_",",4,"I")+YSRSC4
+9 FOR I=19:1:22
SET YSRSC5=$$GET1^DIQ(601.75,$PIECE(YSDATA(I),"^",3)_",",4,"I")+YSRSC5
+10 FOR I=23:1:26
SET YSRSC6=$$GET1^DIQ(601.75,$PIECE(YSDATA(I),"^",3)_",",4,"I")+YSRSC6
+11 FOR I=27:1:30
SET YSRSC7=$$GET1^DIQ(601.75,$PIECE(YSDATA(I),"^",3)_",",4,"I")+YSRSC7
+12 SET SLIDESC=$PIECE(YSDATA(31),"^",3)
+13 SET YSTSC1=$$BRADJ1(YSRSC1)
+14 SET YSTSC2=$$BRADJ2(YSRSC2)
+15 SET YSTSC3=$$BRADJ3(YSRSC3)
+16 SET YSTSC4=$$BRADJ4(YSRSC4)
+17 SET YSTSC5=$$BRADJ5(YSRSC5)
+18 SET YSTSC6=$$BRADJ6(YSRSC6)
+19 SET YSTSC7=$$BRADJ7(YSRSC7)
+20 QUIT
+21 ;
BRADJ1(YSRSC1) ;Adjust the Base Rate based on Scales - Physical Function
+1 if YSRSC1=4
QUIT 22.9
+2 if YSRSC1=5
QUIT 26.9
+3 if YSRSC1=4
QUIT 22.9
+4 if YSRSC1=5
QUIT 26.9
+5 if YSRSC1=6
QUIT 29.1
+6 if YSRSC1=7
QUIT 30.7
+7 if YSRSC1=8
QUIT 32.1
+8 if YSRSC1=9
QUIT 33.3
+9 if YSRSC1=10
QUIT 34.4
+10 if YSRSC1=11
QUIT 35.6
+11 if YSRSC1=12
QUIT 36.7
+12 if YSRSC1=13
QUIT 37.9
+13 if YSRSC1=14
QUIT 39.1
+14 if YSRSC1=15
QUIT 40.4
+15 if YSRSC1=16
QUIT 41.8
+16 if YSRSC1=17
QUIT 43.4
+17 if YSRSC1=18
QUIT 45.3
+18 if YSRSC1=19
QUIT 48.0
+19 if YSRSC1=20
QUIT 56.9
+20 QUIT ""
+21 ;
BRADJ2(YSRSC2) ;Adjust the Base Rate based on Scales - Anxiety
+1 if YSRSC2=4
QUIT 40.3
+2 if YSRSC2=5
QUIT 48.0
+3 if YSRSC2=6
QUIT 51.2
+4 if YSRSC2=7
QUIT 53.7
+5 if YSRSC2=8
QUIT 55.8
+6 if YSRSC2=9
QUIT 57.7
+7 if YSRSC2=10
QUIT 59.5
+8 if YSRSC2=11
QUIT 61.4
+9 if YSRSC2=12
QUIT 63.4
+10 if YSRSC2=13
QUIT 65.3
+11 if YSRSC2=14
QUIT 67.3
+12 if YSRSC2=15
QUIT 69.3
+13 if YSRSC2=16
QUIT 71.2
+14 if YSRSC2=17
QUIT 73.3
+15 if YSRSC2=18
QUIT 75.4
+16 if YSRSC2=19
QUIT 77.9
+17 if YSRSC2=20
QUIT 81.6
+18 QUIT ""
+19 ;
BRADJ3(YSRSC3) ;Adjust the Base Rate based on Scales - Depression
+1 if YSRSC3=4
QUIT 41.0
+2 if YSRSC3=5
QUIT 49.0
+3 if YSRSC3=6
QUIT 51.8
+4 if YSRSC3=7
QUIT 53.9
+5 if YSRSC3=8
QUIT 55.7
+6 if YSRSC3=9
QUIT 57.3
+7 if YSRSC3=10
QUIT 58.9
+8 if YSRSC3=11
QUIT 60.5
+9 if YSRSC3=12
QUIT 62.2
+10 if YSRSC3=13
QUIT 63.9
+11 if YSRSC3=14
QUIT 65.7
+12 if YSRSC3=15
QUIT 67.5
+13 if YSRSC3=16
QUIT 69.4
+14 if YSRSC3=17
QUIT 71.2
+15 if YSRSC3=18
QUIT 73.3
+16 if YSRSC3=19
QUIT 75.7
+17 if YSRSC3=20
QUIT 79.4
+18 QUIT ""
+19 ;
BRADJ4(YSRSC4) ;Adjust the Base Rate based on Scales - Fatigue
+1 if YSRSC4=4
QUIT 33.7
+2 if YSRSC4=5
QUIT 39.7
+3 if YSRSC4=6
QUIT 43.1
+4 if YSRSC4=7
QUIT 46.0
+5 if YSRSC4=8
QUIT 48.6
+6 if YSRSC4=9
QUIT 51.0
+7 if YSRSC4=10
QUIT 53.1
+8 if YSRSC4=11
QUIT 55.1
+9 if YSRSC4=12
QUIT 57.0
+10 if YSRSC4=13
QUIT 58.8
+11 if YSRSC4=14
QUIT 60.7
+12 if YSRSC4=15
QUIT 62.7
+13 if YSRSC4=16
QUIT 64.6
+14 if YSRSC4=17
QUIT 66.7
+15 if YSRSC4=18
QUIT 69.0
+16 if YSRSC4=19
QUIT 71.6
+17 if YSRSC4=20
QUIT 75.8
+18 QUIT ""
+19 ;
BRADJ5(YSRSC5) ;Adjust the Base Rate based on Scales - Sleep Disturbance
+1 if YSRSC5=4
QUIT 32.0
+2 if YSRSC5=5
QUIT 37.5
+3 if YSRSC5=6
QUIT 41.1
+4 if YSRSC5=7
QUIT 43.8
+5 if YSRSC5=8
QUIT 46.2
+6 if YSRSC5=9
QUIT 48.4
+7 if YSRSC5=10
QUIT 50.5
+8 if YSRSC5=11
QUIT 52.4
+9 if YSRSC5=12
QUIT 54.3
+10 if YSRSC5=13
QUIT 56.1
+11 if YSRSC5=14
QUIT 57.9
+12 if YSRSC5=15
QUIT 59.8
+13 if YSRSC5=16
QUIT 61.7
+14 if YSRSC5=17
QUIT 63.8
+15 if YSRSC5=18
QUIT 66.0
+16 if YSRSC5=19
QUIT 68.8
+17 if YSRSC5=20
QUIT 73.3
+18 QUIT ""
+19 ;
BRADJ6(YSRSC6) ;Adjust the Base Rate based on Scales - Satisfaction with Social Role
+1 if YSRSC6=4
QUIT 27.5
+2 if YSRSC6=5
QUIT 31.8
+3 if YSRSC6=6
QUIT 34.0
+4 if YSRSC6=7
QUIT 35.7
+5 if YSRSC6=8
QUIT 37.3
+6 if YSRSC6=9
QUIT 38.8
+7 if YSRSC6=10
QUIT 40.5
+8 if YSRSC6=11
QUIT 42.3
+9 if YSRSC6=12
QUIT 44.2
+10 if YSRSC6=13
QUIT 46.2
+11 if YSRSC6=14
QUIT 48.1
+12 if YSRSC6=15
QUIT 50.0
+13 if YSRSC6=16
QUIT 51.9
+14 if YSRSC6=17
QUIT 53.7
+15 if YSRSC6=18
QUIT 55.8
+16 if YSRSC6=19
QUIT 58.3
+17 if YSRSC6=20
QUIT 64.2
+18 QUIT ""
+19 ;
BRADJ7(YSRSC7) ;Adjust the Base Rate based on Scales - Pain Interference
+1 if YSRSC7=4
QUIT 41.6
+2 if YSRSC7=5
QUIT 49.6
+3 if YSRSC7=6
QUIT 52.0
+4 if YSRSC7=7
QUIT 53.9
+5 if YSRSC7=8
QUIT 55.6
+6 if YSRSC7=9
QUIT 57.1
+7 if YSRSC7=10
QUIT 58.5
+8 if YSRSC7=11
QUIT 59.9
+9 if YSRSC7=12
QUIT 61.2
+10 if YSRSC7=13
QUIT 52.5
+11 if YSRSC7=14
QUIT 63.8
+12 if YSRSC7=15
QUIT 65.2
+13 if YSRSC7=16
QUIT 66.6
+14 if YSRSC7=17
QUIT 68.0
+15 if YSRSC7=18
QUIT 69.7
+16 if YSRSC7=19
QUIT 71.6
+17 if YSRSC7=20
QUIT 75.6
+18 QUIT ""
+19 ;
PAD(VAL,LENGTH) ; padds the value with spaces at beginning
+1 NEW RETURN,PADDING
+2 IF VAL="Left blank by the user."
SET VAL="--"
+3 SET PADDING=LENGTH-$LENGTH(VAL)
+4 IF PADDING'>0
QUIT VAL
+5 SET $PIECE(RETURN," ",PADDING+1)=VAL
+6 QUIT RETURN
+7 ;
STRING ;
+1 SET YSRSC1=$PIECE($GET(^TMP($JOB,"YSCOR",2)),"=",2)
SET YSRSC1=$PIECE(YSRSC1,U,1)
+2 SET YSTSC1=$PIECE($GET(^TMP($JOB,"YSCOR",2)),U,2)
+3 SET YSRSC2=$PIECE($GET(^TMP($JOB,"YSCOR",3)),"=",2)
SET YSRSC2=$PIECE(YSRSC2,U,1)
+4 SET YSTSC2=$PIECE($GET(^TMP($JOB,"YSCOR",3)),U,2)
+5 SET YSRSC3=$PIECE($GET(^TMP($JOB,"YSCOR",4)),"=",2)
SET YSRSC3=$PIECE(YSRSC3,U,1)
+6 SET YSTSC3=$PIECE($GET(^TMP($JOB,"YSCOR",4)),U,2)
+7 SET YSRSC4=$PIECE($GET(^TMP($JOB,"YSCOR",5)),"=",2)
SET YSRSC4=$PIECE(YSRSC4,U,1)
+8 SET YSTSC4=$PIECE($GET(^TMP($JOB,"YSCOR",5)),U,2)
+9 SET YSRSC5=$PIECE($GET(^TMP($JOB,"YSCOR",6)),"=",2)
SET YSRSC5=$PIECE(YSRSC5,U,1)
+10 SET YSTSC5=$PIECE($GET(^TMP($JOB,"YSCOR",6)),U,2)
+11 SET YSRSC6=$PIECE($GET(^TMP($JOB,"YSCOR",7)),"=",2)
SET YSRSC6=$PIECE(YSRSC6,U,1)
+12 SET YSTSC6=$PIECE($GET(^TMP($JOB,"YSCOR",7)),U,2)
+13 SET YSRSC7=$PIECE($GET(^TMP($JOB,"YSCOR",8)),"=",2)
SET YSRSC7=$PIECE(YSRSC7,U,1)
+14 SET YSTSC7=$PIECE($GET(^TMP($JOB,"YSCOR",8)),U,2)
+15 SET YSDATA(N)="7771^9999;1^"_$$PAD(YSRSC1,2)
SET N=N+1
+16 SET YSDATA(N)="7772^9999;1^"_$$PAD(YSRSC2,2)
SET N=N+1
+17 SET YSDATA(N)="7773^9999;1^"_$$PAD(YSRSC3,2)
SET N=N+1
+18 SET YSDATA(N)="7774^9999;1^"_$$PAD(YSRSC4,2)
SET N=N+1
+19 SET YSDATA(N)="7775^9999;1^"_$$PAD(YSRSC5,2)
SET N=N+1
+20 SET YSDATA(N)="7776^9999;1^"_$$PAD(YSRSC6,2)
SET N=N+1
+21 SET YSDATA(N)="7777^9999;1^"_$$PAD(YSRSC7,2)
SET N=N+1
+22 SET YSDATA(N)="7778^9999;1^"_YSTSC1
SET N=N+1
+23 SET YSDATA(N)="7779^9999;1^"_YSTSC2
SET N=N+1
+24 SET YSDATA(N)="7780^9999;1^"_YSTSC3
SET N=N+1
+25 SET YSDATA(N)="7781^9999;1^"_YSTSC4
SET N=N+1
+26 SET YSDATA(N)="7782^9999;1^"_YSTSC5
SET N=N+1
+27 SET YSDATA(N)="7783^9999;1^"_YSTSC6
SET N=N+1
+28 SET YSDATA(N)="7784^9999;1^"_YSTSC7
SET N=N+1
+29 QUIT
+30 ;
LDSCORES(YSDATA,YS) ; new call for patch 123 using to get T-scores
+1 ;input:AD = ADMINISTRATION #
+2 ;output: [DATA]
+3 NEW G,N,IEN71,SCALE,YSAD,YSCODEN,YSCALE
+4 SET YSAD=$GET(YS("AD"))
+5 ;
+6 SET YSDATA=$NAME(^TMP($JOB,"YSCOR"))
+7 SET ^TMP($JOB,"YSCOR",1)="[DATA]"
SET N=1
+8 ;
+9 SET YSCALE=""
SET N=1
+10 FOR
SET YSCALE=$ORDER(^YTT(601.92,"AC",YSAD,YSCALE))
if 'YSCALE
QUIT
Begin DoDot:1
+11 SET G=$GET(^YTT(601.92,YSCALE,0))
+12 SET SCALE=$PIECE(G,U,3)
SET N=N+1
+13 SET ^TMP($JOB,"YSCOR",N)=SCALE_"="_$PIECE(G,U,4,7)
End DoDot:1
+14 QUIT
+15 ;
