YTSWHODA ;SLC/PIJ - Score WHODAS 2; 01/08/2016
;;5.01;MENTAL HEALTH;**123**;DEC 30,1994;Build 73
;
;Public, Supported ICRs
; #2056 - Fileman API - $$GET1^DIQ
;
Q
;
DESGNTR(YSQN,DES) ;
; Can't call DESGNTER in YTSCORE: YTSWHODA uses entire designator, expects to see D#.#, not D.
N STR76
S DES="NO DESIGNATOR"
Q:'$G(YSQN)
S STR76=$O(^YTT(601.76,"AE",YSQN,0))
Q:'$G(STR76)
S DES=$P($G(^YTT(601.76,STR76,0)),U,5)
Q
DATA1 ;
S YSINSNAM=$P(YSDATA(2),U,3)
I $G(YSINSNAM)="" S YSINSNAM=$G(YS("CODE"),"NO NAME PASSED")
S NODE=2 F S NODE=$O(YSDATA(NODE)) Q:NODE="" D
.S DATA=YSDATA(NODE)
.S YSQN=$P(DATA,U,1)
.S YSSEQ=$P(DATA,U,2),YSSEQ=$P(YSSEQ,";",1)
.S YSCDA=$P($G(DATA),U,3)
.D DESGNTR(YSQN,.DES)
.S LEG=$$GET1^DIQ(601.75,YSCDA_",",4,"I")
.;
.I YSCDA=3035 S LEG=4 ; Extreme or cannot do
.I YSCDA=5 S LEG=3 ; Severe
.I YSCDA=4 S LEG=2 ; Moderate
.I YSCDA=3 S LEG=1 ; Mild
.I YSCDA=1 S LEG=0 ; None
.;
.I YSCDA=1156 Q ; "Not asked (due to responses on other questions)"
.; If question = "SKIPPED"
.I LEG="X" D Q ; YSCDA = 1155 = Skipped
..I $P(DES,".",1)="D1" S COGM=COGM+1 Q
..I $P(DES,".",1)="D2" S MOBILM=MOBILM+1 Q
..I $P(DES,".",1)="D3" S SELFM=SELFM+1 Q
..I $P(DES,".",1)="D4" S ALONGM=ALONGM+1 Q
..I $P(DES,".",1)="D5" D Q
...I (DES>="D5.1"),(DES<="D5.4") D Q
....S LIFE1M=LIFE1M+1
...I (DES>="D5.5"),(DES<="D5.8") D Q
....S LIFE2M=LIFE2M+1
..I $P(DES,".",1)="D6" S PARTM=PARTM+1 Q
.; Cognition
.I (DES="D1.1") S COG=COG+LEG Q
.I (DES="D1.2") S COG=COG+LEG Q
.I (DES="D1.3") S COG=COG+LEG Q
.I (DES="D1.4") S COG=COG+LEG Q
.I (DES="D1.5") D Q
..I (LEG=1)!(LEG=2) S COG=COG+1 Q
..I (LEG=3)!(LEG=4) S COG=COG+2 Q
.I (DES="D1.6") D Q
..I (LEG=1)!(LEG=2) S COG=COG+1 Q
..I (LEG=3)!(LEG=4) S COG=COG+2 Q
.;
.;Getting around - Mobility
.I (DES="D2.1") S MOBIL=MOBIL+LEG Q
.I (DES="D2.2") D Q
..I (LEG=1)!(LEG=2) S MOBIL=MOBIL+1 Q
..I (LEG=3)!(LEG=4) S MOBIL=MOBIL+2 Q
.I (DES="D2.3") D Q
..I (LEG=1)!(LEG=2) S MOBIL=MOBIL+1 Q
..I (LEG=3)!(LEG=4) S MOBIL=MOBIL+2 Q
.I (DES="D2.4") S MOBIL=MOBIL+LEG Q
.I (DES="D2.5") S MOBIL=MOBIL+LEG Q
.;
.; Self-Care
.I (DES="D3.1") D Q
..I (LEG=1)!(LEG=2) S SELF=SELF+1 Q
..I (LEG=3)!(LEG=4) S SELF=SELF+2 Q
.I (DES="D3.2") S SELF=SELF+LEG Q
.I (DES="D3.3") D Q
..I (LEG=1)!(LEG=2) S SELF=SELF+1 Q
..I (LEG=3)!(LEG=4) S SELF=SELF+2 Q
.I (DES="D3.4") D Q
..I (LEG=1)!(LEG=2) S SELF=SELF+1 Q
..I (LEG=3)!(LEG=4) S SELF=SELF+2 Q
.;
.; Getting Along
.I (DES="D4.1") D Q
..I (LEG=1)!(LEG=2) S ALONG=ALONG+1 Q
..I (LEG=3)!(LEG=4) S ALONG=ALONG+2 Q
.I (DES="D4.2") D Q
..I (LEG=1)!(LEG=2) S ALONG=ALONG+1 Q
..I (LEG=3)!(LEG=4) S ALONG=ALONG+2 Q
.I (DES="D4.3") D Q
..I (LEG=1)!(LEG=2) S ALONG=ALONG+1 Q
..I (LEG=3)!(LEG=4) S ALONG=ALONG+2 Q
.I (DES="D4.4") S ALONG=ALONG+LEG Q
.I (DES="D4.5") D Q
..I (LEG=1)!(LEG=2) S ALONG=ALONG+1 Q
..I (LEG=3)!(LEG=4) S ALONG=ALONG+2 Q
.;
.; Life activities: Household
.I (DES="D5.1") D Q
..I (LEG=1)!(LEG=2) S LIFE1=LIFE1+1 Q
..I (LEG=3)!(LEG=4) S LIFE1=LIFE1+2 Q
.I (DES="D5.2") D Q
..I (LEG=1)!(LEG=2) S LIFE1=LIFE1+1 Q
..I (LEG=3)!(LEG=4) S LIFE1=LIFE1+2 Q
.I (DES="D5.3") S LIFE1=LIFE1+LEG Q
.I (DES="D5.4") D Q
..I (LEG=1)!(LEG=2) S LIFE1=LIFE1+1 Q
..I (LEG=3)!(LEG=4) S LIFE1=LIFE1+2 Q
.; Are you working
.I (LEG="Y") S WORKING="true" Q
.; Life activities: work/school
.I (DES="D5.5") D Q
..I (LEG=1)!(LEG=2) S LIFE2=LIFE2+1 Q
..I (LEG=3)!(LEG=4) S LIFE2=LIFE2+2 Q
.I (DES="D5.6") S LIFE2=LIFE2+LEG Q
.I (DES="D5.7") S LIFE2=LIFE2+LEG Q
.I (DES="D5.8") S LIFE2=LIFE2+LEG Q
.; Participation in Society
.I (DES="D6.1") D
..I (LEG=1)!(LEG=2) S PART=PART+1 Q
..I (LEG=3)!(LEG=4) S PART=PART+2 Q
.I (DES="D6.2") S PART=PART+LEG Q
.I (DES="D6.3") D Q
..I (LEG=1)!(LEG=2) S PART=PART+1 Q
..I (LEG=3)!(LEG=4) S PART=PART+2 Q
.I (DES="D6.4") S PART=PART+LEG Q
.I (DES="D6.5") S PART=PART+LEG Q
.I (DES="D6.6") D Q
..I (LEG=1)!(LEG=2) S PART=PART+1 Q
..I (LEG=3)!(LEG=4) S PART=PART+2 Q
.I (DES="D6.7") S PART=PART+LEG Q
.I (DES="D6.8") D Q
..I (LEG=1)!(LEG=2) S PART=PART+1 Q
..I (LEG=3)!(LEG=4) S PART=PART+2 Q
Q
;
CALCS ; Calculations for missing questions
I (COGM+MOBILM+SELFM+ALONGM+LIFE1M+LIFE2M+PARTM)>2 D Q
.S STRING="||WHO Disability Assessment Schedule Domains "
.S STRING=STRING_"| Too many missing answers. Max is 2.:"
.S STRING=STRING_"|| Range is 0 to 100 where 0 indicates no disability and 100 means full disability.|"
.S FLAG=2 ; Quit out
; One missing Cognitive score: Use the average of the other scores for missing score.
I (COGM=1) D
.S COG=COG+(COG/5)
S COGSTR=((COG*100)/20)
; One missing Mobil score
I (MOBILM=1) D
.S MOBIL=MOBIL+(MOBIL/5)
S MOBILSTR=((MOBIL*100)/16)
; One missing Self score
I (SELFM=1) D
.S SELF=SELF+(SELF/4)
S SELFSTR=((SELF*100)/10)
; One missing Getting Along score
I (ALONGM=1) D
.S ALONG=ALONG+(ALONG/5)
S ALONGSTR=((ALONG*100)/12)
; One missing Life score
I (LIFE1M=1) D
.S LIFE1=LIFE1+(LIFE1/4)
S LIFESTR1=((LIFE1*100)/10)
; One missing Life score for working folks
I (WORKING="true") D
.I (LIFE2M=1) D
..S LIFE2=LIFE2+(LIFE2/4)
.S LIFESTR2=(LIFE2*100)/14
I (WORKING'="true") S LIFESTR2="N/A",FLAG=1
; One missing participation score
I (PARTM=1) D
.S PART=PART+(PART/8)
S PARTSTR=((PART*100)/24)
Q
;
STRING ;
I '$D(^TMP($J,"YSCOR")) D Q
.S STRING1="| "_YSINSNAM_" score could not be determined. "
;
S COGSTR=$P($G(^TMP($J,"YSCOR",2)),"=",2)
S MOBILSTR=$P($G(^TMP($J,"YSCOR",3)),"=",2)
S SELFSTR=$P($G(^TMP($J,"YSCOR",4)),"=",2)
S ALONGSTR=$P($G(^TMP($J,"YSCOR",5)),"=",2)
S LIFESTR1=$P($G(^TMP($J,"YSCOR",6)),"=",2)
S LIFESTR2=$P($G(^TMP($J,"YSCOR",7)),"=",2)
S PARTSTR=$P($G(^TMP($J,"YSCOR",8)),"=",2)
S TOTAL=$P($G(^TMP($J,"YSCOR",9)),"=",2)
;
S STRING="|| WHO Disability Assessment Schedule Domains "
; Using $P vs. $J because $J rounds upward and we need exact
;
S STRING=STRING_"| Cognition: "_COGSTR
S STRING=STRING_"| Mobility: "_MOBILSTR
S STRING=STRING_"| Self-care: "_SELFSTR
S STRING=STRING_"| Getting along: "_ALONGSTR
S STRING=STRING_"| Life activities (household): "_LIFESTR1
S STRING=STRING_"| Life activities (work/school): "_LIFESTR2
S STRING=STRING_"| Participation: "_PARTSTR
S STRING=STRING_"| Summary: "_TOTAL
S STRING=STRING_"|| Range is 0 to 100 where 0 indicates no disability and 100 means full disability."
Q
;
TOTAL ;
I WORKING="true" D Q
. S TOTAL=(((COG+MOBIL+SELF+ALONG+LIFE1+LIFE2+PART)*100)/106)
S TOTAL=(((COG+MOBIL+SELF+ALONG+LIFE1+PART)*100)/92)
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)="No Scale found for ADMIN: "_YS("AD")
;
K ^TMP($J,"YSCOR")
K ^TMP($J,"YSCOR") S YSDATA=$NA(^TMP($J,"YSCOR"))
S ^TMP($J,"YSCOR",1)="[DATA]"
S ^TMP($J,"YSCOR",2)=$$GET1^DIQ(601.87,634_",",3,"I")_"="_$P(COGSTR,".",1)
S ^TMP($J,"YSCOR",3)=$$GET1^DIQ(601.87,635_",",3,"I")_"="_$P(MOBILSTR,".",1)
S ^TMP($J,"YSCOR",4)=$$GET1^DIQ(601.87,636_",",3,"I")_"="_$P(SELFSTR,".",1)
S ^TMP($J,"YSCOR",5)=$$GET1^DIQ(601.87,637_",",3,"I")_"="_$P(ALONGSTR,".",1)
S ^TMP($J,"YSCOR",6)=$$GET1^DIQ(601.87,638_",",3,"I")_"="_$P(LIFESTR1,".",1)
S ^TMP($J,"YSCOR",7)=$$GET1^DIQ(601.87,639_",",3,"I")_"="_$S(LIFESTR2="N/A":"N/A",1:$P(LIFESTR2,".",1))
S ^TMP($J,"YSCOR",8)=$$GET1^DIQ(601.87,640_",",3,"I")_"="_$P(PARTSTR,".",1)
S ^TMP($J,"YSCOR",9)=$$GET1^DIQ(601.87,641_",",3,"I")_"="_$P(TOTAL,".",1)
Q
;
DLLSTR(YSDATA,YS,YSTRNG) ;
; YSTRNG = 1 Score Instrument
; YSTRNG = 2 get Report Answers and Text
N DATA,DES,NODE,LEG,YSCDA,YSQN,YSINSNAM,YSSEQ
N STRING,STRING1,TOTAL
N COG,MOBIL,SELF,ALONG,LIFE1,LIFE2,PART,WORKING
N COGM,MOBILM,SELFM,ALONGM,LIFE1M,LIFE2M,PARTM
N COGSTR,MOBILSTR,SELFSTR,ALONGSTR,LIFESTR1,LIFESTR2,PARTSTR
N FLAG
;
S (DES,STRING,STRING1)=""
S FLAG=0,WORKING=""
S (COG,MOBIL,SELF,ALONG,LIFE1,LIFE2,PART,TOTAL)=0
S (COGM,MOBILM,SELFM,ALONGM,LIFE1M,LIFE2M,PARTM)=0
S (COGSTR,MOBILSTR,SELFSTR,ALONGSTR,LIFESTR1,LIFESTR2,PARTSTR)=0
;
D DATA1
D CALCS
I YSTRNG=1 D
.D TOTAL
.D SCORESV
I YSTRNG=2 D
.D LDSCORES^YTSCORE(.YSDATA,.YS)
.D STRING
.S YSDATA($O(YSDATA(""),-1)+1)=999999999999_U_U_STRING Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTSWHODA 8625 printed Oct 16, 2024@18:22:33 Page 2
YTSWHODA ;SLC/PIJ - Score WHODAS 2; 01/08/2016
+1 ;;5.01;MENTAL HEALTH;**123**;DEC 30,1994;Build 73
+2 ;
+3 ;Public, Supported ICRs
+4 ; #2056 - Fileman API - $$GET1^DIQ
+5 ;
+6 QUIT
+7 ;
DESGNTR(YSQN,DES) ;
+1 ; Can't call DESGNTER in YTSCORE: YTSWHODA uses entire designator, expects to see D#.#, not D.
+2 NEW STR76
+3 SET DES="NO DESIGNATOR"
+4 if '$GET(YSQN)
QUIT
+5 SET STR76=$ORDER(^YTT(601.76,"AE",YSQN,0))
+6 if '$GET(STR76)
QUIT
+7 SET DES=$PIECE($GET(^YTT(601.76,STR76,0)),U,5)
+8 QUIT
DATA1 ;
+1 SET YSINSNAM=$PIECE(YSDATA(2),U,3)
+2 IF $GET(YSINSNAM)=""
SET YSINSNAM=$GET(YS("CODE"),"NO NAME PASSED")
+3 SET NODE=2
FOR
SET NODE=$ORDER(YSDATA(NODE))
if NODE=""
QUIT
Begin DoDot:1
+4 SET DATA=YSDATA(NODE)
+5 SET YSQN=$PIECE(DATA,U,1)
+6 SET YSSEQ=$PIECE(DATA,U,2)
SET YSSEQ=$PIECE(YSSEQ,";",1)
+7 SET YSCDA=$PIECE($GET(DATA),U,3)
+8 DO DESGNTR(YSQN,.DES)
+9 SET LEG=$$GET1^DIQ(601.75,YSCDA_",",4,"I")
+10 ;
+11 ; Extreme or cannot do
IF YSCDA=3035
SET LEG=4
+12 ; Severe
IF YSCDA=5
SET LEG=3
+13 ; Moderate
IF YSCDA=4
SET LEG=2
+14 ; Mild
IF YSCDA=3
SET LEG=1
+15 ; None
IF YSCDA=1
SET LEG=0
+16 ;
+17 ; "Not asked (due to responses on other questions)"
IF YSCDA=1156
QUIT
+18 ; If question = "SKIPPED"
+19 ; YSCDA = 1155 = Skipped
IF LEG="X"
Begin DoDot:2
+20 IF $PIECE(DES,".",1)="D1"
SET COGM=COGM+1
QUIT
+21 IF $PIECE(DES,".",1)="D2"
SET MOBILM=MOBILM+1
QUIT
+22 IF $PIECE(DES,".",1)="D3"
SET SELFM=SELFM+1
QUIT
+23 IF $PIECE(DES,".",1)="D4"
SET ALONGM=ALONGM+1
QUIT
+24 IF $PIECE(DES,".",1)="D5"
Begin DoDot:3
+25 IF (DES>="D5.1")
IF (DES<="D5.4")
Begin DoDot:4
+26 SET LIFE1M=LIFE1M+1
End DoDot:4
QUIT
+27 IF (DES>="D5.5")
IF (DES<="D5.8")
Begin DoDot:4
+28 SET LIFE2M=LIFE2M+1
End DoDot:4
QUIT
End DoDot:3
QUIT
+29 IF $PIECE(DES,".",1)="D6"
SET PARTM=PARTM+1
QUIT
End DoDot:2
QUIT
+30 ; Cognition
+31 IF (DES="D1.1")
SET COG=COG+LEG
QUIT
+32 IF (DES="D1.2")
SET COG=COG+LEG
QUIT
+33 IF (DES="D1.3")
SET COG=COG+LEG
QUIT
+34 IF (DES="D1.4")
SET COG=COG+LEG
QUIT
+35 IF (DES="D1.5")
Begin DoDot:2
+36 IF (LEG=1)!(LEG=2)
SET COG=COG+1
QUIT
+37 IF (LEG=3)!(LEG=4)
SET COG=COG+2
QUIT
End DoDot:2
QUIT
+38 IF (DES="D1.6")
Begin DoDot:2
+39 IF (LEG=1)!(LEG=2)
SET COG=COG+1
QUIT
+40 IF (LEG=3)!(LEG=4)
SET COG=COG+2
QUIT
End DoDot:2
QUIT
+41 ;
+42 ;Getting around - Mobility
+43 IF (DES="D2.1")
SET MOBIL=MOBIL+LEG
QUIT
+44 IF (DES="D2.2")
Begin DoDot:2
+45 IF (LEG=1)!(LEG=2)
SET MOBIL=MOBIL+1
QUIT
+46 IF (LEG=3)!(LEG=4)
SET MOBIL=MOBIL+2
QUIT
End DoDot:2
QUIT
+47 IF (DES="D2.3")
Begin DoDot:2
+48 IF (LEG=1)!(LEG=2)
SET MOBIL=MOBIL+1
QUIT
+49 IF (LEG=3)!(LEG=4)
SET MOBIL=MOBIL+2
QUIT
End DoDot:2
QUIT
+50 IF (DES="D2.4")
SET MOBIL=MOBIL+LEG
QUIT
+51 IF (DES="D2.5")
SET MOBIL=MOBIL+LEG
QUIT
+52 ;
+53 ; Self-Care
+54 IF (DES="D3.1")
Begin DoDot:2
+55 IF (LEG=1)!(LEG=2)
SET SELF=SELF+1
QUIT
+56 IF (LEG=3)!(LEG=4)
SET SELF=SELF+2
QUIT
End DoDot:2
QUIT
+57 IF (DES="D3.2")
SET SELF=SELF+LEG
QUIT
+58 IF (DES="D3.3")
Begin DoDot:2
+59 IF (LEG=1)!(LEG=2)
SET SELF=SELF+1
QUIT
+60 IF (LEG=3)!(LEG=4)
SET SELF=SELF+2
QUIT
End DoDot:2
QUIT
+61 IF (DES="D3.4")
Begin DoDot:2
+62 IF (LEG=1)!(LEG=2)
SET SELF=SELF+1
QUIT
+63 IF (LEG=3)!(LEG=4)
SET SELF=SELF+2
QUIT
End DoDot:2
QUIT
+64 ;
+65 ; Getting Along
+66 IF (DES="D4.1")
Begin DoDot:2
+67 IF (LEG=1)!(LEG=2)
SET ALONG=ALONG+1
QUIT
+68 IF (LEG=3)!(LEG=4)
SET ALONG=ALONG+2
QUIT
End DoDot:2
QUIT
+69 IF (DES="D4.2")
Begin DoDot:2
+70 IF (LEG=1)!(LEG=2)
SET ALONG=ALONG+1
QUIT
+71 IF (LEG=3)!(LEG=4)
SET ALONG=ALONG+2
QUIT
End DoDot:2
QUIT
+72 IF (DES="D4.3")
Begin DoDot:2
+73 IF (LEG=1)!(LEG=2)
SET ALONG=ALONG+1
QUIT
+74 IF (LEG=3)!(LEG=4)
SET ALONG=ALONG+2
QUIT
End DoDot:2
QUIT
+75 IF (DES="D4.4")
SET ALONG=ALONG+LEG
QUIT
+76 IF (DES="D4.5")
Begin DoDot:2
+77 IF (LEG=1)!(LEG=2)
SET ALONG=ALONG+1
QUIT
+78 IF (LEG=3)!(LEG=4)
SET ALONG=ALONG+2
QUIT
End DoDot:2
QUIT
+79 ;
+80 ; Life activities: Household
+81 IF (DES="D5.1")
Begin DoDot:2
+82 IF (LEG=1)!(LEG=2)
SET LIFE1=LIFE1+1
QUIT
+83 IF (LEG=3)!(LEG=4)
SET LIFE1=LIFE1+2
QUIT
End DoDot:2
QUIT
+84 IF (DES="D5.2")
Begin DoDot:2
+85 IF (LEG=1)!(LEG=2)
SET LIFE1=LIFE1+1
QUIT
+86 IF (LEG=3)!(LEG=4)
SET LIFE1=LIFE1+2
QUIT
End DoDot:2
QUIT
+87 IF (DES="D5.3")
SET LIFE1=LIFE1+LEG
QUIT
+88 IF (DES="D5.4")
Begin DoDot:2
+89 IF (LEG=1)!(LEG=2)
SET LIFE1=LIFE1+1
QUIT
+90 IF (LEG=3)!(LEG=4)
SET LIFE1=LIFE1+2
QUIT
End DoDot:2
QUIT
+91 ; Are you working
+92 IF (LEG="Y")
SET WORKING="true"
QUIT
+93 ; Life activities: work/school
+94 IF (DES="D5.5")
Begin DoDot:2
+95 IF (LEG=1)!(LEG=2)
SET LIFE2=LIFE2+1
QUIT
+96 IF (LEG=3)!(LEG=4)
SET LIFE2=LIFE2+2
QUIT
End DoDot:2
QUIT
+97 IF (DES="D5.6")
SET LIFE2=LIFE2+LEG
QUIT
+98 IF (DES="D5.7")
SET LIFE2=LIFE2+LEG
QUIT
+99 IF (DES="D5.8")
SET LIFE2=LIFE2+LEG
QUIT
+100 ; Participation in Society
+101 IF (DES="D6.1")
Begin DoDot:2
+102 IF (LEG=1)!(LEG=2)
SET PART=PART+1
QUIT
+103 IF (LEG=3)!(LEG=4)
SET PART=PART+2
QUIT
End DoDot:2
+104 IF (DES="D6.2")
SET PART=PART+LEG
QUIT
+105 IF (DES="D6.3")
Begin DoDot:2
+106 IF (LEG=1)!(LEG=2)
SET PART=PART+1
QUIT
+107 IF (LEG=3)!(LEG=4)
SET PART=PART+2
QUIT
End DoDot:2
QUIT
+108 IF (DES="D6.4")
SET PART=PART+LEG
QUIT
+109 IF (DES="D6.5")
SET PART=PART+LEG
QUIT
+110 IF (DES="D6.6")
Begin DoDot:2
+111 IF (LEG=1)!(LEG=2)
SET PART=PART+1
QUIT
+112 IF (LEG=3)!(LEG=4)
SET PART=PART+2
QUIT
End DoDot:2
QUIT
+113 IF (DES="D6.7")
SET PART=PART+LEG
QUIT
+114 IF (DES="D6.8")
Begin DoDot:2
+115 IF (LEG=1)!(LEG=2)
SET PART=PART+1
QUIT
+116 IF (LEG=3)!(LEG=4)
SET PART=PART+2
QUIT
End DoDot:2
QUIT
End DoDot:1
+117 QUIT
+118 ;
CALCS ; Calculations for missing questions
+1 IF (COGM+MOBILM+SELFM+ALONGM+LIFE1M+LIFE2M+PARTM)>2
Begin DoDot:1
+2 SET STRING="||WHO Disability Assessment Schedule Domains "
+3 SET STRING=STRING_"| Too many missing answers. Max is 2.:"
+4 SET STRING=STRING_"|| Range is 0 to 100 where 0 indicates no disability and 100 means full disability.|"
+5 ; Quit out
SET FLAG=2
End DoDot:1
QUIT
+6 ; One missing Cognitive score: Use the average of the other scores for missing score.
+7 IF (COGM=1)
Begin DoDot:1
+8 SET COG=COG+(COG/5)
End DoDot:1
+9 SET COGSTR=((COG*100)/20)
+10 ; One missing Mobil score
+11 IF (MOBILM=1)
Begin DoDot:1
+12 SET MOBIL=MOBIL+(MOBIL/5)
End DoDot:1
+13 SET MOBILSTR=((MOBIL*100)/16)
+14 ; One missing Self score
+15 IF (SELFM=1)
Begin DoDot:1
+16 SET SELF=SELF+(SELF/4)
End DoDot:1
+17 SET SELFSTR=((SELF*100)/10)
+18 ; One missing Getting Along score
+19 IF (ALONGM=1)
Begin DoDot:1
+20 SET ALONG=ALONG+(ALONG/5)
End DoDot:1
+21 SET ALONGSTR=((ALONG*100)/12)
+22 ; One missing Life score
+23 IF (LIFE1M=1)
Begin DoDot:1
+24 SET LIFE1=LIFE1+(LIFE1/4)
End DoDot:1
+25 SET LIFESTR1=((LIFE1*100)/10)
+26 ; One missing Life score for working folks
+27 IF (WORKING="true")
Begin DoDot:1
+28 IF (LIFE2M=1)
Begin DoDot:2
+29 SET LIFE2=LIFE2+(LIFE2/4)
End DoDot:2
+30 SET LIFESTR2=(LIFE2*100)/14
End DoDot:1
+31 IF (WORKING'="true")
SET LIFESTR2="N/A"
SET FLAG=1
+32 ; One missing participation score
+33 IF (PARTM=1)
Begin DoDot:1
+34 SET PART=PART+(PART/8)
End DoDot:1
+35 SET PARTSTR=((PART*100)/24)
+36 QUIT
+37 ;
STRING ;
+1 IF '$DATA(^TMP($JOB,"YSCOR"))
Begin DoDot:1
+2 SET STRING1="| "_YSINSNAM_" score could not be determined. "
End DoDot:1
QUIT
+3 ;
+4 SET COGSTR=$PIECE($GET(^TMP($JOB,"YSCOR",2)),"=",2)
+5 SET MOBILSTR=$PIECE($GET(^TMP($JOB,"YSCOR",3)),"=",2)
+6 SET SELFSTR=$PIECE($GET(^TMP($JOB,"YSCOR",4)),"=",2)
+7 SET ALONGSTR=$PIECE($GET(^TMP($JOB,"YSCOR",5)),"=",2)
+8 SET LIFESTR1=$PIECE($GET(^TMP($JOB,"YSCOR",6)),"=",2)
+9 SET LIFESTR2=$PIECE($GET(^TMP($JOB,"YSCOR",7)),"=",2)
+10 SET PARTSTR=$PIECE($GET(^TMP($JOB,"YSCOR",8)),"=",2)
+11 SET TOTAL=$PIECE($GET(^TMP($JOB,"YSCOR",9)),"=",2)
+12 ;
+13 SET STRING="|| WHO Disability Assessment Schedule Domains "
+14 ; Using $P vs. $J because $J rounds upward and we need exact
+15 ;
+16 SET STRING=STRING_"| Cognition: "_COGSTR
+17 SET STRING=STRING_"| Mobility: "_MOBILSTR
+18 SET STRING=STRING_"| Self-care: "_SELFSTR
+19 SET STRING=STRING_"| Getting along: "_ALONGSTR
+20 SET STRING=STRING_"| Life activities (household): "_LIFESTR1
+21 SET STRING=STRING_"| Life activities (work/school): "_LIFESTR2
+22 SET STRING=STRING_"| Participation: "_PARTSTR
+23 SET STRING=STRING_"| Summary: "_TOTAL
+24 SET STRING=STRING_"|| Range is 0 to 100 where 0 indicates no disability and 100 means full disability."
+25 QUIT
+26 ;
TOTAL ;
+1 IF WORKING="true"
Begin DoDot:1
+2 SET TOTAL=(((COG+MOBIL+SELF+ALONG+LIFE1+LIFE2+PART)*100)/106)
End DoDot:1
QUIT
+3 SET TOTAL=(((COG+MOBIL+SELF+ALONG+LIFE1+PART)*100)/92)
+4 QUIT
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)="No Scale found for ADMIN: "_YS("AD")
End DoDot:1
QUIT
+5 ;
+6 KILL ^TMP($JOB,"YSCOR")
+7 KILL ^TMP($JOB,"YSCOR")
SET YSDATA=$NAME(^TMP($JOB,"YSCOR"))
+8 SET ^TMP($JOB,"YSCOR",1)="[DATA]"
+9 SET ^TMP($JOB,"YSCOR",2)=$$GET1^DIQ(601.87,634_",",3,"I")_"="_$PIECE(COGSTR,".",1)
+10 SET ^TMP($JOB,"YSCOR",3)=$$GET1^DIQ(601.87,635_",",3,"I")_"="_$PIECE(MOBILSTR,".",1)
+11 SET ^TMP($JOB,"YSCOR",4)=$$GET1^DIQ(601.87,636_",",3,"I")_"="_$PIECE(SELFSTR,".",1)
+12 SET ^TMP($JOB,"YSCOR",5)=$$GET1^DIQ(601.87,637_",",3,"I")_"="_$PIECE(ALONGSTR,".",1)
+13 SET ^TMP($JOB,"YSCOR",6)=$$GET1^DIQ(601.87,638_",",3,"I")_"="_$PIECE(LIFESTR1,".",1)
+14 SET ^TMP($JOB,"YSCOR",7)=$$GET1^DIQ(601.87,639_",",3,"I")_"="_$SELECT(LIFESTR2="N/A":"N/A",1:$PIECE(LIFESTR2,".",1))
+15 SET ^TMP($JOB,"YSCOR",8)=$$GET1^DIQ(601.87,640_",",3,"I")_"="_$PIECE(PARTSTR,".",1)
+16 SET ^TMP($JOB,"YSCOR",9)=$$GET1^DIQ(601.87,641_",",3,"I")_"="_$PIECE(TOTAL,".",1)
+17 QUIT
+18 ;
DLLSTR(YSDATA,YS,YSTRNG) ;
+1 ; YSTRNG = 1 Score Instrument
+2 ; YSTRNG = 2 get Report Answers and Text
+3 NEW DATA,DES,NODE,LEG,YSCDA,YSQN,YSINSNAM,YSSEQ
+4 NEW STRING,STRING1,TOTAL
+5 NEW COG,MOBIL,SELF,ALONG,LIFE1,LIFE2,PART,WORKING
+6 NEW COGM,MOBILM,SELFM,ALONGM,LIFE1M,LIFE2M,PARTM
+7 NEW COGSTR,MOBILSTR,SELFSTR,ALONGSTR,LIFESTR1,LIFESTR2,PARTSTR
+8 NEW FLAG
+9 ;
+10 SET (DES,STRING,STRING1)=""
+11 SET FLAG=0
SET WORKING=""
+12 SET (COG,MOBIL,SELF,ALONG,LIFE1,LIFE2,PART,TOTAL)=0
+13 SET (COGM,MOBILM,SELFM,ALONGM,LIFE1M,LIFE2M,PARTM)=0
+14 SET (COGSTR,MOBILSTR,SELFSTR,ALONGSTR,LIFESTR1,LIFESTR2,PARTSTR)=0
+15 ;
+16 DO DATA1
+17 DO CALCS
+18 IF YSTRNG=1
Begin DoDot:1
+19 DO TOTAL
+20 DO SCORESV
End DoDot:1
+21 IF YSTRNG=2
Begin DoDot:1
+22 DO LDSCORES^YTSCORE(.YSDATA,.YS)
+23 DO STRING
+24 SET YSDATA($ORDER(YSDATA(""),-1)+1)=999999999999_U_U_STRING
QUIT
End DoDot:1
+25 QUIT
