- 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 Feb 18, 2025@23:46:56 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 ;