YTSALSQL ;ISP/LMT - Score ALSSQOL-SF ;Jul 03, 2024@16:08:53
;;5.01;MENTAL HEALTH;**250**;Dec 30, 1994;Build 26
;
;
DLLSTR(YSDATA,YS,YSTRNG) ; compute scores or report text based on YSTRNG
; input
; YSDATA(2)=adminId^patientDFN^instrumentName^dateGiven^isComplete
; YSDATA(2+n)=questionId^sequence^choiceId
; YS("AD")=adminId
; YSTRNG=1 for score, 2 for report
; output if YSTRNG=1: ^TMP($J,"YSCOR",n)=scaleId=score
; output if YSTRNG=2: append special "answers" to YSDATA
;
I YSTRNG=1 D SCORESV(.YSDATA)
I YSTRNG=2 D
. N YSSCORES,YSN
. D LDSCORES^YTSCORE(.YSDATA,.YS) ; puts score into ^TMP($J,"YSCOR",2)
. S YSSCORES=$$REPORT()
. S YSN=$O(YSDATA(""),-1) ; get last node
. S YSDATA(YSN+1)="7771^9999;1^"_YSSCORES
Q
;
SCORESV(YSDATA) ; calculate the score
; expects YSDATA from DLLSTR (YSDATA from LOADANSW^YTSCORE,SCALEG^YTQAPI3)
;
N YSBULBAR,YSBULBARAVG,YSCOUNT,YSEMOTION,YSEMOTIONAVG,YSI,YSINTERACTION,YSINTERACTIONAVG,YSINTIMACY
N YSINTIMACYAVG,YSJ,YSMAPPINGS,YSNODE,YSPHYSICAL,YSPHYSICALAVG,YSQID,YSQUESTIONS,YSRELIGION
N YSRELIGIONAVG,YSSCALE,YSSCALECONST,YSSCLID,YSSCLNM,YSSCORES,YSSKIPPED,YSTOTAL,YSTOTALAVG,YSVAL,YSX
;
F YSI=1:1 S YSX=$P($T(MAPPING+YSI),";;",2,99) Q:YSX=""!(YSX="zzz") D
. S YSSCALECONST=$P(YSX,U,1)
. S YSSCALE=$P(YSX,U,3)
. S @YSSCALECONST=YSSCALE
. S YSSCORES(YSSCALE)=""
. S YSQUESTIONS=$P(YSX,U,4)
. I YSQUESTIONS="" QUIT
. F YSJ=1:1 S YSQID=$P(YSQUESTIONS,";",YSJ) Q:YSQID="" D
. . S YSMAPPINGS(YSQID)=YSSCALE
;
S YSSKIPPED=0
S YSCOUNT=0
S YSI=2
F S YSI=$O(YSDATA(YSI)) Q:'YSI!(YSSKIPPED) D
. S YSQID=$P(YSDATA(YSI),U)
. S YSVAL=$P(YSDATA(YSI),U,3)
. I 'YSQID QUIT
. S YSSCALE=$G(YSMAPPINGS(YSQID))
. I 'YSSCALE QUIT
. I YSVAL=1155!(YSVAL=1156)!(YSVAL=1157)!(YSVAL'?1.N) S YSSKIPPED=1 QUIT
. S YSCOUNT=YSCOUNT+1
. S YSSCORES(YSSCALE)=YSSCORES(YSSCALE)+YSVAL
I YSCOUNT<20 S YSSKIPPED=1
;
; Inverted scores: Subtract the score for each subsection from the total possible score
S YSSCORES(YSEMOTION)=30-YSSCORES(YSEMOTION)
S YSSCORES(YSPHYSICAL)=50-YSSCORES(YSPHYSICAL)
S YSSCORES(YSBULBAR)=20-YSSCORES(YSBULBAR)
;
S YSSCORES(YSTOTAL)=YSSCORES(YSEMOTION)+YSSCORES(YSPHYSICAL)+YSSCORES(YSBULBAR)+YSSCORES(YSINTERACTION)+YSSCORES(YSRELIGION)+YSSCORES(YSINTIMACY)
;
S YSSCORES(YSTOTALAVG)=$J(YSSCORES(YSTOTAL)/20,0,2)
S YSSCORES(YSEMOTIONAVG)=$J(YSSCORES(YSEMOTION)/3,0,2)
S YSSCORES(YSPHYSICALAVG)=$J(YSSCORES(YSPHYSICAL)/5,0,2)
S YSSCORES(YSBULBARAVG)=$J(YSSCORES(YSBULBAR)/2,0,2)
S YSSCORES(YSINTERACTIONAVG)=$J(YSSCORES(YSINTERACTION)/4,0,2)
S YSSCORES(YSRELIGIONAVG)=$J(YSSCORES(YSRELIGION)/2,0,2)
S YSSCORES(YSINTIMACYAVG)=$J(YSSCORES(YSINTIMACY)/4,0,2)
;
; set scores into ^TMP($J,"YSCOR",n)=scaleName=score {rawScore^tScore}
K ^TMP($J,"YSCOR")
I $D(^TMP($J,"YSG",1)),^TMP($J,"YSG",1)="[ERROR]" D Q ;-->out
. S ^TMP($J,"YSCOR",1)="[ERROR]"
. S ^TMP($J,"YSCOR",2)="No Scale found for ADMIN"
;
S ^TMP($J,"YSCOR",1)="[DATA]"
S YSI=2
S YSJ=1
F S YSI=$O(^TMP($J,"YSG",YSI)) Q:'YSI D
. S YSNODE=$G(^TMP($J,"YSG",YSI))
. I $P(YSNODE,"=",1)["Group" QUIT
. S YSSCLID=+$P(YSNODE,"=",2)
. S YSSCLNM=$P(YSNODE,U,4)
. S YSJ=YSJ+1
. S ^TMP($J,"YSCOR",YSJ)=YSSCLNM_"="_$S('YSSKIPPED:$G(YSSCORES(YSSCLID)),1:"")
Q
;
;
MAPPING ;Map question IDs to scales; Constant^Scale Name^Scale ID^Questions IDs
;;YSTOTAL^Total Score^1598
;;YSEMOTION^Negative Emotion^1599^9538;9542;9543
;;YSPHYSICAL^Physical Functioning^1600^9529;9530;9533;9534;9535
;;YSBULBAR^Bulbar Function^1601^9531;9532
;;YSINTERACTION^Interaction with people and the Environment^1602^9536;9537;9539;9544
;;YSRELIGION^Religiosity^1603^9540;9541
;;YSINTIMACY^Intimacy^1604^9545;9546;9547;9548
;;YSTOTALAVG^Average Total^1591
;;YSEMOTIONAVG^Negative Emotion Avg^1592
;;YSPHYSICALAVG^Physical Functioning Avg^1593
;;YSBULBARAVG^Bulbar Function Avg^1594
;;YSINTERACTIONAVG^Interaction with people and the Environment Avg^1595
;;YSRELIGIONAVG^Religiosity Avg^1596
;;YSINTIMACYAVG^Intimacy Avg^1597
;;zzz
;
;
REPORT(YSRETURN) ; build the scoring display for the report
; expects ^TMP($J,"YSCOR",...) and ^TMP($J,"YSG") from DLLSTR
; YSDATA from DLLSTR
;
N YSBULBAR,YSBULBARAVG,YSEMOTION,YSEMOTIONAVG,YSI,YSINTERACTION,YSINTERACTIONAVG,YSINTIMACY,YSINTIMACYAVG
N YSNAME,YSPHYSICAL,YSPHYSICALAVG,YSRELIGION,YSRELIGIONAVG,YSSCALE,YSSCALECONST,YSSCALEMAP,YSSCALENAME
N YSSCORES,YSSKIPPED,YSTOTAL,YSTOTALAVG,YSVALUE,YSX
;
F YSI=1:1 S YSX=$P($T(MAPPING+YSI),";;",2,99) Q:YSX=""!(YSX="zzz") D
. S YSSCALECONST=$P(YSX,U,1)
. S YSSCALENAME=$P(YSX,U,2)
. S YSSCALE=$P(YSX,U,3)
. S @YSSCALECONST=YSSCALE
. S YSSCALEMAP(YSSCALENAME)=YSSCALE
. S YSSCORES(YSSCALE)=""
;
S YSI=0 F S YSI=$O(^TMP($J,"YSCOR",YSI)) Q:'YSI D
. S YSNAME=$P(^TMP($J,"YSCOR",YSI),"=")
. S YSVALUE=$P(^TMP($J,"YSCOR",YSI),"=",2)
. I YSNAME="" QUIT
. S YSSCALE=$G(YSSCALEMAP(YSNAME))
. I YSSCALE="" QUIT
. S YSSCORES(YSSCALE)=YSVALUE
;
S YSSKIPPED=0
S YSSCALE=0
F S YSSCALE=$O(YSSCORES(YSSCALE)) Q:YSSCALE="" D
. I $G(YSSCORES(YSSCALE))="" S YSSKIPPED=1
;
I YSSKIPPED D QUIT YSRETURN
. S YSRETURN="|No scores due to skipped items."
;
S YSX=""
S YSX=YSX_"| Negative Emotion Total: "_$J(YSSCORES(YSEMOTION),3)_" (Max=30)"
S YSX=YSX_"| Physical Functioning Total: "_$J(YSSCORES(YSPHYSICAL),3)_" (Max=50)"
S YSX=YSX_"| Bulbar Function Total: "_$J(YSSCORES(YSBULBAR),3)_" (Max=20)"
S YSX=YSX_"| Interaction with people and the Environment Total: "_$J(YSSCORES(YSINTERACTION),3)_" (Max=40)"
S YSX=YSX_"| Religiosity Total: "_$J(YSSCORES(YSRELIGION),3)_" (Max=20)"
S YSX=YSX_"| Intimacy Total: "_$J(YSSCORES(YSINTIMACY),3)_" (Max=40)"
S YSX=YSX_"| TOTAL SCORE: "_$J(YSSCORES(YSTOTAL),3)_" (Max=200)"
S YSX=YSX_"|"
S YSX=YSX_"| Negative Emotion Average: "_$J(YSSCORES(YSEMOTIONAVG),0,2)
S YSX=YSX_"| Physical Functioning Average: "_$J(YSSCORES(YSPHYSICALAVG),0,2)
S YSX=YSX_"| Bulbar Function Average: "_$J(YSSCORES(YSBULBARAVG),0,2)
S YSX=YSX_"| Interaction with people and the Environment Average: "_$J(YSSCORES(YSINTERACTIONAVG),0,2)
S YSX=YSX_"| Religiosity Average: "_$J(YSSCORES(YSRELIGIONAVG),0,2)
S YSX=YSX_"| Intimacy Average: "_$J(YSSCORES(YSINTIMACYAVG),0,2)
S YSX=YSX_"| AVERAGE TOTAL SCORE: "_$J(YSSCORES(YSTOTALAVG),0,2)
S YSX=YSX_"|"
S YSX=YSX_"|Averages are reported as a value between 0 (worse) and 10 (best)."
S YSRETURN=YSX
;
Q YSRETURN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTSALSQL 6906 printed Aug 26, 2025@22:35 Page 2
YTSALSQL ;ISP/LMT - Score ALSSQOL-SF ;Jul 03, 2024@16:08:53
+1 ;;5.01;MENTAL HEALTH;**250**;Dec 30, 1994;Build 26
+2 ;
+3 ;
DLLSTR(YSDATA,YS,YSTRNG) ; compute scores or report text based on YSTRNG
+1 ; input
+2 ; YSDATA(2)=adminId^patientDFN^instrumentName^dateGiven^isComplete
+3 ; YSDATA(2+n)=questionId^sequence^choiceId
+4 ; YS("AD")=adminId
+5 ; YSTRNG=1 for score, 2 for report
+6 ; output if YSTRNG=1: ^TMP($J,"YSCOR",n)=scaleId=score
+7 ; output if YSTRNG=2: append special "answers" to YSDATA
+8 ;
+9 IF YSTRNG=1
DO SCORESV(.YSDATA)
+10 IF YSTRNG=2
Begin DoDot:1
+11 NEW YSSCORES,YSN
+12 ; puts score into ^TMP($J,"YSCOR",2)
DO LDSCORES^YTSCORE(.YSDATA,.YS)
+13 SET YSSCORES=$$REPORT()
+14 ; get last node
SET YSN=$ORDER(YSDATA(""),-1)
+15 SET YSDATA(YSN+1)="7771^9999;1^"_YSSCORES
End DoDot:1
+16 QUIT
+17 ;
SCORESV(YSDATA) ; calculate the score
+1 ; expects YSDATA from DLLSTR (YSDATA from LOADANSW^YTSCORE,SCALEG^YTQAPI3)
+2 ;
+3 NEW YSBULBAR,YSBULBARAVG,YSCOUNT,YSEMOTION,YSEMOTIONAVG,YSI,YSINTERACTION,YSINTERACTIONAVG,YSINTIMACY
+4 NEW YSINTIMACYAVG,YSJ,YSMAPPINGS,YSNODE,YSPHYSICAL,YSPHYSICALAVG,YSQID,YSQUESTIONS,YSRELIGION
+5 NEW YSRELIGIONAVG,YSSCALE,YSSCALECONST,YSSCLID,YSSCLNM,YSSCORES,YSSKIPPED,YSTOTAL,YSTOTALAVG,YSVAL,YSX
+6 ;
+7 FOR YSI=1:1
SET YSX=$PIECE($TEXT(MAPPING+YSI),";;",2,99)
if YSX=""!(YSX="zzz")
QUIT
Begin DoDot:1
+8 SET YSSCALECONST=$PIECE(YSX,U,1)
+9 SET YSSCALE=$PIECE(YSX,U,3)
+10 SET @YSSCALECONST=YSSCALE
+11 SET YSSCORES(YSSCALE)=""
+12 SET YSQUESTIONS=$PIECE(YSX,U,4)
+13 IF YSQUESTIONS=""
QUIT
+14 FOR YSJ=1:1
SET YSQID=$PIECE(YSQUESTIONS,";",YSJ)
if YSQID=""
QUIT
Begin DoDot:2
+15 SET YSMAPPINGS(YSQID)=YSSCALE
End DoDot:2
End DoDot:1
+16 ;
+17 SET YSSKIPPED=0
+18 SET YSCOUNT=0
+19 SET YSI=2
+20 FOR
SET YSI=$ORDER(YSDATA(YSI))
if 'YSI!(YSSKIPPED)
QUIT
Begin DoDot:1
+21 SET YSQID=$PIECE(YSDATA(YSI),U)
+22 SET YSVAL=$PIECE(YSDATA(YSI),U,3)
+23 IF 'YSQID
QUIT
+24 SET YSSCALE=$GET(YSMAPPINGS(YSQID))
+25 IF 'YSSCALE
QUIT
+26 IF YSVAL=1155!(YSVAL=1156)!(YSVAL=1157)!(YSVAL'?1.N)
SET YSSKIPPED=1
QUIT
+27 SET YSCOUNT=YSCOUNT+1
+28 SET YSSCORES(YSSCALE)=YSSCORES(YSSCALE)+YSVAL
End DoDot:1
+29 IF YSCOUNT<20
SET YSSKIPPED=1
+30 ;
+31 ; Inverted scores: Subtract the score for each subsection from the total possible score
+32 SET YSSCORES(YSEMOTION)=30-YSSCORES(YSEMOTION)
+33 SET YSSCORES(YSPHYSICAL)=50-YSSCORES(YSPHYSICAL)
+34 SET YSSCORES(YSBULBAR)=20-YSSCORES(YSBULBAR)
+35 ;
+36 SET YSSCORES(YSTOTAL)=YSSCORES(YSEMOTION)+YSSCORES(YSPHYSICAL)+YSSCORES(YSBULBAR)+YSSCORES(YSINTERACTION)+YSSCORES(YSRELIGION)+YSSCORES(YSINTIMACY)
+37 ;
+38 SET YSSCORES(YSTOTALAVG)=$JUSTIFY(YSSCORES(YSTOTAL)/20,0,2)
+39 SET YSSCORES(YSEMOTIONAVG)=$JUSTIFY(YSSCORES(YSEMOTION)/3,0,2)
+40 SET YSSCORES(YSPHYSICALAVG)=$JUSTIFY(YSSCORES(YSPHYSICAL)/5,0,2)
+41 SET YSSCORES(YSBULBARAVG)=$JUSTIFY(YSSCORES(YSBULBAR)/2,0,2)
+42 SET YSSCORES(YSINTERACTIONAVG)=$JUSTIFY(YSSCORES(YSINTERACTION)/4,0,2)
+43 SET YSSCORES(YSRELIGIONAVG)=$JUSTIFY(YSSCORES(YSRELIGION)/2,0,2)
+44 SET YSSCORES(YSINTIMACYAVG)=$JUSTIFY(YSSCORES(YSINTIMACY)/4,0,2)
+45 ;
+46 ; set scores into ^TMP($J,"YSCOR",n)=scaleName=score {rawScore^tScore}
+47 KILL ^TMP($JOB,"YSCOR")
+48 ;-->out
IF $DATA(^TMP($JOB,"YSG",1))
IF ^TMP($JOB,"YSG",1)="[ERROR]"
Begin DoDot:1
+49 SET ^TMP($JOB,"YSCOR",1)="[ERROR]"
+50 SET ^TMP($JOB,"YSCOR",2)="No Scale found for ADMIN"
End DoDot:1
QUIT
+51 ;
+52 SET ^TMP($JOB,"YSCOR",1)="[DATA]"
+53 SET YSI=2
+54 SET YSJ=1
+55 FOR
SET YSI=$ORDER(^TMP($JOB,"YSG",YSI))
if 'YSI
QUIT
Begin DoDot:1
+56 SET YSNODE=$GET(^TMP($JOB,"YSG",YSI))
+57 IF $PIECE(YSNODE,"=",1)["Group"
QUIT
+58 SET YSSCLID=+$PIECE(YSNODE,"=",2)
+59 SET YSSCLNM=$PIECE(YSNODE,U,4)
+60 SET YSJ=YSJ+1
+61 SET ^TMP($JOB,"YSCOR",YSJ)=YSSCLNM_"="_$SELECT('YSSKIPPED:$GET(YSSCORES(YSSCLID)),1:"")
End DoDot:1
+62 QUIT
+63 ;
+64 ;
MAPPING ;Map question IDs to scales; Constant^Scale Name^Scale ID^Questions IDs
+1 ;;YSTOTAL^Total Score^1598
+2 ;;YSEMOTION^Negative Emotion^1599^9538;9542;9543
+3 ;;YSPHYSICAL^Physical Functioning^1600^9529;9530;9533;9534;9535
+4 ;;YSBULBAR^Bulbar Function^1601^9531;9532
+5 ;;YSINTERACTION^Interaction with people and the Environment^1602^9536;9537;9539;9544
+6 ;;YSRELIGION^Religiosity^1603^9540;9541
+7 ;;YSINTIMACY^Intimacy^1604^9545;9546;9547;9548
+8 ;;YSTOTALAVG^Average Total^1591
+9 ;;YSEMOTIONAVG^Negative Emotion Avg^1592
+10 ;;YSPHYSICALAVG^Physical Functioning Avg^1593
+11 ;;YSBULBARAVG^Bulbar Function Avg^1594
+12 ;;YSINTERACTIONAVG^Interaction with people and the Environment Avg^1595
+13 ;;YSRELIGIONAVG^Religiosity Avg^1596
+14 ;;YSINTIMACYAVG^Intimacy Avg^1597
+15 ;;zzz
+16 ;
+17 ;
REPORT(YSRETURN) ; build the scoring display for the report
+1 ; expects ^TMP($J,"YSCOR",...) and ^TMP($J,"YSG") from DLLSTR
+2 ; YSDATA from DLLSTR
+3 ;
+4 NEW YSBULBAR,YSBULBARAVG,YSEMOTION,YSEMOTIONAVG,YSI,YSINTERACTION,YSINTERACTIONAVG,YSINTIMACY,YSINTIMACYAVG
+5 NEW YSNAME,YSPHYSICAL,YSPHYSICALAVG,YSRELIGION,YSRELIGIONAVG,YSSCALE,YSSCALECONST,YSSCALEMAP,YSSCALENAME
+6 NEW YSSCORES,YSSKIPPED,YSTOTAL,YSTOTALAVG,YSVALUE,YSX
+7 ;
+8 FOR YSI=1:1
SET YSX=$PIECE($TEXT(MAPPING+YSI),";;",2,99)
if YSX=""!(YSX="zzz")
QUIT
Begin DoDot:1
+9 SET YSSCALECONST=$PIECE(YSX,U,1)
+10 SET YSSCALENAME=$PIECE(YSX,U,2)
+11 SET YSSCALE=$PIECE(YSX,U,3)
+12 SET @YSSCALECONST=YSSCALE
+13 SET YSSCALEMAP(YSSCALENAME)=YSSCALE
+14 SET YSSCORES(YSSCALE)=""
End DoDot:1
+15 ;
+16 SET YSI=0
FOR
SET YSI=$ORDER(^TMP($JOB,"YSCOR",YSI))
if 'YSI
QUIT
Begin DoDot:1
+17 SET YSNAME=$PIECE(^TMP($JOB,"YSCOR",YSI),"=")
+18 SET YSVALUE=$PIECE(^TMP($JOB,"YSCOR",YSI),"=",2)
+19 IF YSNAME=""
QUIT
+20 SET YSSCALE=$GET(YSSCALEMAP(YSNAME))
+21 IF YSSCALE=""
QUIT
+22 SET YSSCORES(YSSCALE)=YSVALUE
End DoDot:1
+23 ;
+24 SET YSSKIPPED=0
+25 SET YSSCALE=0
+26 FOR
SET YSSCALE=$ORDER(YSSCORES(YSSCALE))
if YSSCALE=""
QUIT
Begin DoDot:1
+27 IF $GET(YSSCORES(YSSCALE))=""
SET YSSKIPPED=1
End DoDot:1
+28 ;
+29 IF YSSKIPPED
Begin DoDot:1
+30 SET YSRETURN="|No scores due to skipped items."
End DoDot:1
QUIT YSRETURN
+31 ;
+32 SET YSX=""
+33 SET YSX=YSX_"| Negative Emotion Total: "_$JUSTIFY(YSSCORES(YSEMOTION),3)_" (Max=30)"
+34 SET YSX=YSX_"| Physical Functioning Total: "_$JUSTIFY(YSSCORES(YSPHYSICAL),3)_" (Max=50)"
+35 SET YSX=YSX_"| Bulbar Function Total: "_$JUSTIFY(YSSCORES(YSBULBAR),3)_" (Max=20)"
+36 SET YSX=YSX_"| Interaction with people and the Environment Total: "_$JUSTIFY(YSSCORES(YSINTERACTION),3)_" (Max=40)"
+37 SET YSX=YSX_"| Religiosity Total: "_$JUSTIFY(YSSCORES(YSRELIGION),3)_" (Max=20)"
+38 SET YSX=YSX_"| Intimacy Total: "_$JUSTIFY(YSSCORES(YSINTIMACY),3)_" (Max=40)"
+39 SET YSX=YSX_"| TOTAL SCORE: "_$JUSTIFY(YSSCORES(YSTOTAL),3)_" (Max=200)"
+40 SET YSX=YSX_"|"
+41 SET YSX=YSX_"| Negative Emotion Average: "_$JUSTIFY(YSSCORES(YSEMOTIONAVG),0,2)
+42 SET YSX=YSX_"| Physical Functioning Average: "_$JUSTIFY(YSSCORES(YSPHYSICALAVG),0,2)
+43 SET YSX=YSX_"| Bulbar Function Average: "_$JUSTIFY(YSSCORES(YSBULBARAVG),0,2)
+44 SET YSX=YSX_"| Interaction with people and the Environment Average: "_$JUSTIFY(YSSCORES(YSINTERACTIONAVG),0,2)
+45 SET YSX=YSX_"| Religiosity Average: "_$JUSTIFY(YSSCORES(YSRELIGIONAVG),0,2)
+46 SET YSX=YSX_"| Intimacy Average: "_$JUSTIFY(YSSCORES(YSINTIMACYAVG),0,2)
+47 SET YSX=YSX_"| AVERAGE TOTAL SCORE: "_$JUSTIFY(YSSCORES(YSTOTALAVG),0,2)
+48 SET YSX=YSX_"|"
+49 SET YSX=YSX_"|Averages are reported as a value between 0 (worse) and 10 (best)."
+50 SET YSRETURN=YSX
+51 ;
+52 QUIT YSRETURN
