YTSQLES ;SLC/MJB- SCORE QLES ; 9/26/2018
;;5.01;MENTAL HEALTH;**151,249**;DEC 30,1994;Build 30
;
;
; Reference to DIQ in ICR #2056
;
Q
;
DLLSTR(YSDATA,YS,YSTRNG) ;
;
N TOTAL,TXT,YSMED,YSOVER,YSTOTAL,YSCRIT9,YSCRIT11,YSCRIT12,YSCRIT13,YSCALEI,YSSCALIEN
N YSCRIT9Q,YSCRIT11Q,YSCRIT12Q,YSCRIT13Q,YSCRITA,YSCRITB,YSCRITC,QLESQSF,II,YSTOTALA
N YSSCNAM,YSINSNAM
S N=N+1,II=0
IF YSTRNG=1 D DATA1 D SCORESV
I YSTRNG=2 D
.D LDSCORES(.YSDATA,.YS) D YSARRAY(.QLESQSF) ;run YSARRAY again to get the responses and add 0 to skipped questions
.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
;
K ^TMP($J,"YSCOR")
S ^TMP($J,"YSCOR",1)="[DATA]"
S YSSCALIEN=1224 ;this needs to be changed to the current instrument scale
S ^TMP($J,"YSCOR",2)=$$GET1^DIQ(601.87,YSSCALIEN_",",3,"I")_"="_YSTOTAL_U_YSTOTALA
Q
;
DATA1 ;
D YSARRAY(.QLESQSF)
F II=3:1:16 S YSTOTAL=$G(YSTOTAL)+QLESQSF(II)
S YSTOTALA=((YSTOTAL-14)/.56)
S YSTOTALA=$FN(YSTOTALA,"",0)
Q
;
STRING ;
S YSTOTAL=$P($G(^TMP($J,"YSCOR",2)),"=",2),YSTOTAL=$P(YSTOTAL,U,1)
S YSTOTALA=$P($G(^TMP($J,"YSCOR",2)),U,2)
S YSMED=QLESQSF(17)
S YSOVER=QLESQSF(18)
S YSCRIT9=QLESQSF(11)
S YSCRIT11=QLESQSF(13)
S YSCRIT12=QLESQSF(14)
S YSCRIT13=QLESQSF(15)
S YSCRIT9Q="9. Your sexual drive, interest and/or performance?"
S YSCRIT11Q="11. Your living/housing situation?"
S YSCRIT12Q="12. Your ability to get around physically without feeling dizzy or unsteady or falling?"
S YSCRIT13Q="13. Your vision in terms of ability to do work or hobbies?"
S YSCRITA="1.Very Poor"
S YSCRITB="2.Poor"
S YSCRITC="3.Fair"
;I YSMED=0 S YSDATA(N)="7771^9999;1^Item omitted by respondent" S N=N+1
;I YSMED=1 S YSDATA(N)="7771^9999;1^VERY POOR" S N=N+1
;I YSMED=2 S YSDATA(N)="7771^9999;1^POOR" S N=N+1
;I YSMED=3 S YSDATA(N)="7771^9999;1^FAIR" S N=N+1
;I YSMED=4 S YSDATA(N)="7771^9999;1^GOOD" S N=N+1
;I YSMED=5 S YSDATA(N)="7771^9999;1^VERY GOOD" S N=N+1
S YSDATA(N)="7771^9999;1^"_$S(YSMED=1:"VERY POOR",YSMED=2:"POOR",YSMED=3:"FAIR",YSMED=4:"GOOD",YSMED=5:"VERY GOOD",1:"Item omitted by respondent"),N=N+1
;I YSOVER=1 S YSDATA(N)="7772^9999;1^VERY POOR" S N=N+1
;I YSOVER=2 S YSDATA(N)="7772^9999;1^POOR" S N=N+1
;I YSOVER=3 S YSDATA(N)="7772^9999;1^FAIR" S N=N+1
;I YSOVER=4 S YSDATA(N)="7772^9999;1^GOOD" S N=N+1
;I YSOVER=5 S YSDATA(N)="7772^9999;1^VERY GOOD" S N=N+1
S YSDATA(N)="7772^9999;1^"_$S(YSOVER=1:"VERY POOR",YSOVER=2:"POOR",YSOVER=3:"FAIR",YSOVER=4:"GOOD",YSOVER=5:"VERY GOOD",1:"Item omitted by respondent"),N=N+1
;I (YSCRIT9=1)!(YSCRIT9=2)!(YSCRIT9=3) S YSDATA(N)="7773^9999;1^"_YSCRIT9Q S N=N+1
;I YSCRIT9=1 S YSDATA(N)="7774^9999;1^"_YSCRITA S N=N+1
;I YSCRIT9=2 S YSDATA(N)="7774^9999;1^"_YSCRITB S N=N+1
;I YSCRIT9=3 S YSDATA(N)="7774^9999;1^"_YSCRITC S N=N+1
;I (YSCRIT11=1)!(YSCRIT11=2)!(YSCRIT11=3) S YSDATA(N)="7775^9999;1^"_YSCRIT11Q S N=N+1
;I YSCRIT11=1 S YSDATA(N)="7780^9999;1^"_YSCRITA S N=N+1
;I YSCRIT11=2 S YSDATA(N)="7780^9999;1^"_YSCRITB S N=N+1
;I YSCRIT11=3 S YSDATA(N)="7780^9999;1^"_YSCRITC S N=N+1
;I (YSCRIT12=1)!(YSCRIT12=2)!(YSCRIT12=3) S YSDATA(N)="7776^9999;1^"_YSCRIT12Q S N=N+1
;I YSCRIT12=1 S YSDATA(N)="7781^9999;1^"_YSCRITA S N=N+1
;I YSCRIT12=2 S YSDATA(N)="7781^9999;1^"_YSCRITB S N=N+1
;I YSCRIT12=3 S YSDATA(N)="7781^9999;1^"_YSCRITC S N=N+1
;I (YSCRIT13=1)!(YSCRIT13=2)!(YSCRIT13=3) S YSDATA(N)="7777^9999;1^"_YSCRIT13Q S N=N+1
;I YSCRIT13=1 S YSDATA(N)="7782^9999;1^"_YSCRITA S N=N+1
;I YSCRIT13=2 S YSDATA(N)="7782^9999;1^"_YSCRITB S N=N+1
;I YSCRIT13=3 S YSDATA(N)="7782^9999;1^"_YSCRITC S N=N+1
;I (YSCRIT9)&(YSCRIT11)&(YSCRIT12)&(YSCRIT13)>3 S YSDATA(N)="7778^9999;1^The patient did not endorse critical items"
S YSDATA(N)="7779^9999;1^"_YSTOTALA S N=N+1
;
Q
;
YSARRAY(YSARRAY) ;
N II,YSVAL,YSCALEI,YSKEYI,G,YSQN,YSAI,YSAN,YSTARG
K YSARRAY
S II=""
F II=3:1:18 S YSQN=$P(YSDATA(II),U,1),YSAN=$P(YSDATA(II),U,3) D
.I YSAN=1155 S YSVAL=0
.I YSAN=3921 S YSVAL=1
.I YSAN=3922 S YSVAL=2
.I YSAN=3923 S YSVAL=3
.I YSAN=3924 S YSVAL=4
.I YSAN=3925 S YSVAL=5
.I YSAN=3926 S YSVAL=0
.S YSARRAY(II)=YSVAL
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[HYTSQLES 4824 printed Dec 13, 2024@02:20:42 Page 2
YTSQLES ;SLC/MJB- SCORE QLES ; 9/26/2018
+1 ;;5.01;MENTAL HEALTH;**151,249**;DEC 30,1994;Build 30
+2 ;
+3 ;
+4 ; Reference to DIQ in ICR #2056
+5 ;
+6 QUIT
+7 ;
DLLSTR(YSDATA,YS,YSTRNG) ;
+1 ;
+2 NEW TOTAL,TXT,YSMED,YSOVER,YSTOTAL,YSCRIT9,YSCRIT11,YSCRIT12,YSCRIT13,YSCALEI,YSSCALIEN
+3 NEW YSCRIT9Q,YSCRIT11Q,YSCRIT12Q,YSCRIT13Q,YSCRITA,YSCRITB,YSCRITC,QLESQSF,II,YSTOTALA
+4 NEW YSSCNAM,YSINSNAM
+5 SET N=N+1
SET II=0
+6 IF YSTRNG=1
DO DATA1
DO SCORESV
+7 IF YSTRNG=2
Begin DoDot:1
+8 ;run YSARRAY again to get the responses and add 0 to skipped questions
DO LDSCORES(.YSDATA,.YS)
DO YSARRAY(.QLESQSF)
+9 DO STRING
End DoDot:1
+10 QUIT
+11 ;
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
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
SET YSSCALIEN=1224
+10 SET ^TMP($JOB,"YSCOR",2)=$$GET1^DIQ(601.87,YSSCALIEN_",",3,"I")_"="_YSTOTAL_U_YSTOTALA
+11 QUIT
+12 ;
DATA1 ;
+1 DO YSARRAY(.QLESQSF)
+2 FOR II=3:1:16
SET YSTOTAL=$GET(YSTOTAL)+QLESQSF(II)
+3 SET YSTOTALA=((YSTOTAL-14)/.56)
+4 SET YSTOTALA=$FNUMBER(YSTOTALA,"",0)
+5 QUIT
+6 ;
STRING ;
+1 SET YSTOTAL=$PIECE($GET(^TMP($JOB,"YSCOR",2)),"=",2)
SET YSTOTAL=$PIECE(YSTOTAL,U,1)
+2 SET YSTOTALA=$PIECE($GET(^TMP($JOB,"YSCOR",2)),U,2)
+3 SET YSMED=QLESQSF(17)
+4 SET YSOVER=QLESQSF(18)
+5 SET YSCRIT9=QLESQSF(11)
+6 SET YSCRIT11=QLESQSF(13)
+7 SET YSCRIT12=QLESQSF(14)
+8 SET YSCRIT13=QLESQSF(15)
+9 SET YSCRIT9Q="9. Your sexual drive, interest and/or performance?"
+10 SET YSCRIT11Q="11. Your living/housing situation?"
+11 SET YSCRIT12Q="12. Your ability to get around physically without feeling dizzy or unsteady or falling?"
+12 SET YSCRIT13Q="13. Your vision in terms of ability to do work or hobbies?"
+13 SET YSCRITA="1.Very Poor"
+14 SET YSCRITB="2.Poor"
+15 SET YSCRITC="3.Fair"
+16 ;I YSMED=0 S YSDATA(N)="7771^9999;1^Item omitted by respondent" S N=N+1
+17 ;I YSMED=1 S YSDATA(N)="7771^9999;1^VERY POOR" S N=N+1
+18 ;I YSMED=2 S YSDATA(N)="7771^9999;1^POOR" S N=N+1
+19 ;I YSMED=3 S YSDATA(N)="7771^9999;1^FAIR" S N=N+1
+20 ;I YSMED=4 S YSDATA(N)="7771^9999;1^GOOD" S N=N+1
+21 ;I YSMED=5 S YSDATA(N)="7771^9999;1^VERY GOOD" S N=N+1
+22 SET YSDATA(N)="7771^9999;1^"_$SELECT(YSMED=1:"VERY POOR",YSMED=2:"POOR",YSMED=3:"FAIR",YSMED=4:"GOOD",YSMED=5:"VERY GOOD",1:"Item omitted by respondent")
SET N=N+1
+23 ;I YSOVER=1 S YSDATA(N)="7772^9999;1^VERY POOR" S N=N+1
+24 ;I YSOVER=2 S YSDATA(N)="7772^9999;1^POOR" S N=N+1
+25 ;I YSOVER=3 S YSDATA(N)="7772^9999;1^FAIR" S N=N+1
+26 ;I YSOVER=4 S YSDATA(N)="7772^9999;1^GOOD" S N=N+1
+27 ;I YSOVER=5 S YSDATA(N)="7772^9999;1^VERY GOOD" S N=N+1
+28 SET YSDATA(N)="7772^9999;1^"_$SELECT(YSOVER=1:"VERY POOR",YSOVER=2:"POOR",YSOVER=3:"FAIR",YSOVER=4:"GOOD",YSOVER=5:"VERY GOOD",1:"Item omitted by respondent")
SET N=N+1
+29 ;I (YSCRIT9=1)!(YSCRIT9=2)!(YSCRIT9=3) S YSDATA(N)="7773^9999;1^"_YSCRIT9Q S N=N+1
+30 ;I YSCRIT9=1 S YSDATA(N)="7774^9999;1^"_YSCRITA S N=N+1
+31 ;I YSCRIT9=2 S YSDATA(N)="7774^9999;1^"_YSCRITB S N=N+1
+32 ;I YSCRIT9=3 S YSDATA(N)="7774^9999;1^"_YSCRITC S N=N+1
+33 ;I (YSCRIT11=1)!(YSCRIT11=2)!(YSCRIT11=3) S YSDATA(N)="7775^9999;1^"_YSCRIT11Q S N=N+1
+34 ;I YSCRIT11=1 S YSDATA(N)="7780^9999;1^"_YSCRITA S N=N+1
+35 ;I YSCRIT11=2 S YSDATA(N)="7780^9999;1^"_YSCRITB S N=N+1
+36 ;I YSCRIT11=3 S YSDATA(N)="7780^9999;1^"_YSCRITC S N=N+1
+37 ;I (YSCRIT12=1)!(YSCRIT12=2)!(YSCRIT12=3) S YSDATA(N)="7776^9999;1^"_YSCRIT12Q S N=N+1
+38 ;I YSCRIT12=1 S YSDATA(N)="7781^9999;1^"_YSCRITA S N=N+1
+39 ;I YSCRIT12=2 S YSDATA(N)="7781^9999;1^"_YSCRITB S N=N+1
+40 ;I YSCRIT12=3 S YSDATA(N)="7781^9999;1^"_YSCRITC S N=N+1
+41 ;I (YSCRIT13=1)!(YSCRIT13=2)!(YSCRIT13=3) S YSDATA(N)="7777^9999;1^"_YSCRIT13Q S N=N+1
+42 ;I YSCRIT13=1 S YSDATA(N)="7782^9999;1^"_YSCRITA S N=N+1
+43 ;I YSCRIT13=2 S YSDATA(N)="7782^9999;1^"_YSCRITB S N=N+1
+44 ;I YSCRIT13=3 S YSDATA(N)="7782^9999;1^"_YSCRITC S N=N+1
+45 ;I (YSCRIT9)&(YSCRIT11)&(YSCRIT12)&(YSCRIT13)>3 S YSDATA(N)="7778^9999;1^The patient did not endorse critical items"
+46 SET YSDATA(N)="7779^9999;1^"_YSTOTALA
SET N=N+1
+47 ;
+48 QUIT
+49 ;
YSARRAY(YSARRAY) ;
+1 NEW II,YSVAL,YSCALEI,YSKEYI,G,YSQN,YSAI,YSAN,YSTARG
+2 KILL YSARRAY
+3 SET II=""
+4 FOR II=3:1:18
SET YSQN=$PIECE(YSDATA(II),U,1)
SET YSAN=$PIECE(YSDATA(II),U,3)
Begin DoDot:1
+5 IF YSAN=1155
SET YSVAL=0
+6 IF YSAN=3921
SET YSVAL=1
+7 IF YSAN=3922
SET YSVAL=2
+8 IF YSAN=3923
SET YSVAL=3
+9 IF YSAN=3924
SET YSVAL=4
+10 IF YSAN=3925
SET YSVAL=5
+11 IF YSAN=3926
SET YSVAL=0
+12 SET YSARRAY(II)=YSVAL
End DoDot:1
+13 QUIT
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
