- 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 Feb 18, 2025@23:48:12 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