YTSQLES ;SLC/MJB- SCORE QLES ; 9/26/2018
;;5.01;MENTAL HEALTH;**151**;DEC 30,1994;Build 92
;
;Public, Supported ICRs
; #2056 - Fileman API - $$GET1^DIQ
;
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
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
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 4502 printed Mar 10, 2023@00:16:59 Page 2
YTSQLES ;SLC/MJB- SCORE QLES ; 9/26/2018
+1 ;;5.01;MENTAL HEALTH;**151**;DEC 30,1994;Build 92
+2 ;
+3 ;Public, Supported ICRs
+4 ; #2056 - Fileman API - $$GET1^DIQ
+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 IF YSMED=0
SET YSDATA(N)="7771^9999;1^Item omitted by respondent"
SET N=N+1
+17 IF YSMED=1
SET YSDATA(N)="7771^9999;1^VERY POOR"
SET N=N+1
+18 IF YSMED=2
SET YSDATA(N)="7771^9999;1^POOR"
SET N=N+1
+19 IF YSMED=3
SET YSDATA(N)="7771^9999;1^FAIR"
SET N=N+1
+20 IF YSMED=4
SET YSDATA(N)="7771^9999;1^GOOD"
SET N=N+1
+21 IF YSMED=5
SET YSDATA(N)="7771^9999;1^VERY GOOD"
SET N=N+1
+22 IF YSOVER=1
SET YSDATA(N)="7772^9999;1^VERY POOR"
SET N=N+1
+23 IF YSOVER=2
SET YSDATA(N)="7772^9999;1^POOR"
SET N=N+1
+24 IF YSOVER=3
SET YSDATA(N)="7772^9999;1^FAIR"
SET N=N+1
+25 IF YSOVER=4
SET YSDATA(N)="7772^9999;1^GOOD"
SET N=N+1
+26 IF YSOVER=5
SET YSDATA(N)="7772^9999;1^VERY GOOD"
SET N=N+1
+27 IF (YSCRIT9=1)!(YSCRIT9=2)!(YSCRIT9=3)
SET YSDATA(N)="7773^9999;1^"_YSCRIT9Q
SET N=N+1
+28 IF YSCRIT9=1
SET YSDATA(N)="7774^9999;1^"_YSCRITA
SET N=N+1
+29 IF YSCRIT9=2
SET YSDATA(N)="7774^9999;1^"_YSCRITB
SET N=N+1
+30 IF YSCRIT9=3
SET YSDATA(N)="7774^9999;1^"_YSCRITC
SET N=N+1
+31 IF (YSCRIT11=1)!(YSCRIT11=2)!(YSCRIT11=3)
SET YSDATA(N)="7775^9999;1^"_YSCRIT11Q
SET N=N+1
+32 IF YSCRIT11=1
SET YSDATA(N)="7780^9999;1^"_YSCRITA
SET N=N+1
+33 IF YSCRIT11=2
SET YSDATA(N)="7780^9999;1^"_YSCRITB
SET N=N+1
+34 IF YSCRIT11=3
SET YSDATA(N)="7780^9999;1^"_YSCRITC
SET N=N+1
+35 IF (YSCRIT12=1)!(YSCRIT12=2)!(YSCRIT12=3)
SET YSDATA(N)="7776^9999;1^"_YSCRIT12Q
SET N=N+1
+36 IF YSCRIT12=1
SET YSDATA(N)="7781^9999;1^"_YSCRITA
SET N=N+1
+37 IF YSCRIT12=2
SET YSDATA(N)="7781^9999;1^"_YSCRITB
SET N=N+1
+38 IF YSCRIT12=3
SET YSDATA(N)="7781^9999;1^"_YSCRITC
SET N=N+1
+39 IF (YSCRIT13=1)!(YSCRIT13=2)!(YSCRIT13=3)
SET YSDATA(N)="7777^9999;1^"_YSCRIT13Q
SET N=N+1
+40 IF YSCRIT13=1
SET YSDATA(N)="7782^9999;1^"_YSCRITA
SET N=N+1
+41 IF YSCRIT13=2
SET YSDATA(N)="7782^9999;1^"_YSCRITB
SET N=N+1
+42 IF YSCRIT13=3
SET YSDATA(N)="7782^9999;1^"_YSCRITC
SET N=N+1
+43 IF (YSCRIT9)&(YSCRIT11)&(YSCRIT12)&(YSCRIT13)>3
SET YSDATA(N)="7778^9999;1^The patient did not endorse critical items"
+44 SET YSDATA(N)="7779^9999;1^"_YSTOTALA
SET N=N+1
+45 ;
+46 QUIT
+47 ;
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
