Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: YTSWHODA

YTSWHODA.m

Go to the documentation of this file.
  1. YTSWHODA ;SLC/PIJ - Score WHODAS 2; 01/08/2016
  1. ;;5.01;MENTAL HEALTH;**123**;DEC 30,1994;Build 73
  1. ;
  1. ;Public, Supported ICRs
  1. ; #2056 - Fileman API - $$GET1^DIQ
  1. ;
  1. Q
  1. ;
  1. DESGNTR(YSQN,DES) ;
  1. ; Can't call DESGNTER in YTSCORE: YTSWHODA uses entire designator, expects to see D#.#, not D.
  1. N STR76
  1. S DES="NO DESIGNATOR"
  1. Q:'$G(YSQN)
  1. S STR76=$O(^YTT(601.76,"AE",YSQN,0))
  1. Q:'$G(STR76)
  1. S DES=$P($G(^YTT(601.76,STR76,0)),U,5)
  1. Q
  1. DATA1 ;
  1. S YSINSNAM=$P(YSDATA(2),U,3)
  1. I $G(YSINSNAM)="" S YSINSNAM=$G(YS("CODE"),"NO NAME PASSED")
  1. S NODE=2 F S NODE=$O(YSDATA(NODE)) Q:NODE="" D
  1. .S DATA=YSDATA(NODE)
  1. .S YSQN=$P(DATA,U,1)
  1. .S YSSEQ=$P(DATA,U,2),YSSEQ=$P(YSSEQ,";",1)
  1. .S YSCDA=$P($G(DATA),U,3)
  1. .D DESGNTR(YSQN,.DES)
  1. .S LEG=$$GET1^DIQ(601.75,YSCDA_",",4,"I")
  1. .;
  1. .I YSCDA=3035 S LEG=4 ; Extreme or cannot do
  1. .I YSCDA=5 S LEG=3 ; Severe
  1. .I YSCDA=4 S LEG=2 ; Moderate
  1. .I YSCDA=3 S LEG=1 ; Mild
  1. .I YSCDA=1 S LEG=0 ; None
  1. .;
  1. .I YSCDA=1156 Q ; "Not asked (due to responses on other questions)"
  1. .; If question = "SKIPPED"
  1. .I LEG="X" D Q ; YSCDA = 1155 = Skipped
  1. ..I $P(DES,".",1)="D1" S COGM=COGM+1 Q
  1. ..I $P(DES,".",1)="D2" S MOBILM=MOBILM+1 Q
  1. ..I $P(DES,".",1)="D3" S SELFM=SELFM+1 Q
  1. ..I $P(DES,".",1)="D4" S ALONGM=ALONGM+1 Q
  1. ..I $P(DES,".",1)="D5" D Q
  1. ...I (DES>="D5.1"),(DES<="D5.4") D Q
  1. ....S LIFE1M=LIFE1M+1
  1. ...I (DES>="D5.5"),(DES<="D5.8") D Q
  1. ....S LIFE2M=LIFE2M+1
  1. ..I $P(DES,".",1)="D6" S PARTM=PARTM+1 Q
  1. .; Cognition
  1. .I (DES="D1.1") S COG=COG+LEG Q
  1. .I (DES="D1.2") S COG=COG+LEG Q
  1. .I (DES="D1.3") S COG=COG+LEG Q
  1. .I (DES="D1.4") S COG=COG+LEG Q
  1. .I (DES="D1.5") D Q
  1. ..I (LEG=1)!(LEG=2) S COG=COG+1 Q
  1. ..I (LEG=3)!(LEG=4) S COG=COG+2 Q
  1. .I (DES="D1.6") D Q
  1. ..I (LEG=1)!(LEG=2) S COG=COG+1 Q
  1. ..I (LEG=3)!(LEG=4) S COG=COG+2 Q
  1. .;
  1. .;Getting around - Mobility
  1. .I (DES="D2.1") S MOBIL=MOBIL+LEG Q
  1. .I (DES="D2.2") D Q
  1. ..I (LEG=1)!(LEG=2) S MOBIL=MOBIL+1 Q
  1. ..I (LEG=3)!(LEG=4) S MOBIL=MOBIL+2 Q
  1. .I (DES="D2.3") D Q
  1. ..I (LEG=1)!(LEG=2) S MOBIL=MOBIL+1 Q
  1. ..I (LEG=3)!(LEG=4) S MOBIL=MOBIL+2 Q
  1. .I (DES="D2.4") S MOBIL=MOBIL+LEG Q
  1. .I (DES="D2.5") S MOBIL=MOBIL+LEG Q
  1. .;
  1. .; Self-Care
  1. .I (DES="D3.1") D Q
  1. ..I (LEG=1)!(LEG=2) S SELF=SELF+1 Q
  1. ..I (LEG=3)!(LEG=4) S SELF=SELF+2 Q
  1. .I (DES="D3.2") S SELF=SELF+LEG Q
  1. .I (DES="D3.3") D Q
  1. ..I (LEG=1)!(LEG=2) S SELF=SELF+1 Q
  1. ..I (LEG=3)!(LEG=4) S SELF=SELF+2 Q
  1. .I (DES="D3.4") D Q
  1. ..I (LEG=1)!(LEG=2) S SELF=SELF+1 Q
  1. ..I (LEG=3)!(LEG=4) S SELF=SELF+2 Q
  1. .;
  1. .; Getting Along
  1. .I (DES="D4.1") D Q
  1. ..I (LEG=1)!(LEG=2) S ALONG=ALONG+1 Q
  1. ..I (LEG=3)!(LEG=4) S ALONG=ALONG+2 Q
  1. .I (DES="D4.2") D Q
  1. ..I (LEG=1)!(LEG=2) S ALONG=ALONG+1 Q
  1. ..I (LEG=3)!(LEG=4) S ALONG=ALONG+2 Q
  1. .I (DES="D4.3") D Q
  1. ..I (LEG=1)!(LEG=2) S ALONG=ALONG+1 Q
  1. ..I (LEG=3)!(LEG=4) S ALONG=ALONG+2 Q
  1. .I (DES="D4.4") S ALONG=ALONG+LEG Q
  1. .I (DES="D4.5") D Q
  1. ..I (LEG=1)!(LEG=2) S ALONG=ALONG+1 Q
  1. ..I (LEG=3)!(LEG=4) S ALONG=ALONG+2 Q
  1. .;
  1. .; Life activities: Household
  1. .I (DES="D5.1") D Q
  1. ..I (LEG=1)!(LEG=2) S LIFE1=LIFE1+1 Q
  1. ..I (LEG=3)!(LEG=4) S LIFE1=LIFE1+2 Q
  1. .I (DES="D5.2") D Q
  1. ..I (LEG=1)!(LEG=2) S LIFE1=LIFE1+1 Q
  1. ..I (LEG=3)!(LEG=4) S LIFE1=LIFE1+2 Q
  1. .I (DES="D5.3") S LIFE1=LIFE1+LEG Q
  1. .I (DES="D5.4") D Q
  1. ..I (LEG=1)!(LEG=2) S LIFE1=LIFE1+1 Q
  1. ..I (LEG=3)!(LEG=4) S LIFE1=LIFE1+2 Q
  1. .; Are you working
  1. .I (LEG="Y") S WORKING="true" Q
  1. .; Life activities: work/school
  1. .I (DES="D5.5") D Q
  1. ..I (LEG=1)!(LEG=2) S LIFE2=LIFE2+1 Q
  1. ..I (LEG=3)!(LEG=4) S LIFE2=LIFE2+2 Q
  1. .I (DES="D5.6") S LIFE2=LIFE2+LEG Q
  1. .I (DES="D5.7") S LIFE2=LIFE2+LEG Q
  1. .I (DES="D5.8") S LIFE2=LIFE2+LEG Q
  1. .; Participation in Society
  1. .I (DES="D6.1") D
  1. ..I (LEG=1)!(LEG=2) S PART=PART+1 Q
  1. ..I (LEG=3)!(LEG=4) S PART=PART+2 Q
  1. .I (DES="D6.2") S PART=PART+LEG Q
  1. .I (DES="D6.3") D Q
  1. ..I (LEG=1)!(LEG=2) S PART=PART+1 Q
  1. ..I (LEG=3)!(LEG=4) S PART=PART+2 Q
  1. .I (DES="D6.4") S PART=PART+LEG Q
  1. .I (DES="D6.5") S PART=PART+LEG Q
  1. .I (DES="D6.6") D Q
  1. ..I (LEG=1)!(LEG=2) S PART=PART+1 Q
  1. ..I (LEG=3)!(LEG=4) S PART=PART+2 Q
  1. .I (DES="D6.7") S PART=PART+LEG Q
  1. .I (DES="D6.8") D Q
  1. ..I (LEG=1)!(LEG=2) S PART=PART+1 Q
  1. ..I (LEG=3)!(LEG=4) S PART=PART+2 Q
  1. Q
  1. ;
  1. CALCS ; Calculations for missing questions
  1. I (COGM+MOBILM+SELFM+ALONGM+LIFE1M+LIFE2M+PARTM)>2 D Q
  1. .S STRING="||WHO Disability Assessment Schedule Domains "
  1. .S STRING=STRING_"| Too many missing answers. Max is 2.:"
  1. .S STRING=STRING_"|| Range is 0 to 100 where 0 indicates no disability and 100 means full disability.|"
  1. .S FLAG=2 ; Quit out
  1. ; One missing Cognitive score: Use the average of the other scores for missing score.
  1. I (COGM=1) D
  1. .S COG=COG+(COG/5)
  1. S COGSTR=((COG*100)/20)
  1. ; One missing Mobil score
  1. I (MOBILM=1) D
  1. .S MOBIL=MOBIL+(MOBIL/5)
  1. S MOBILSTR=((MOBIL*100)/16)
  1. ; One missing Self score
  1. I (SELFM=1) D
  1. .S SELF=SELF+(SELF/4)
  1. S SELFSTR=((SELF*100)/10)
  1. ; One missing Getting Along score
  1. I (ALONGM=1) D
  1. .S ALONG=ALONG+(ALONG/5)
  1. S ALONGSTR=((ALONG*100)/12)
  1. ; One missing Life score
  1. I (LIFE1M=1) D
  1. .S LIFE1=LIFE1+(LIFE1/4)
  1. S LIFESTR1=((LIFE1*100)/10)
  1. ; One missing Life score for working folks
  1. I (WORKING="true") D
  1. .I (LIFE2M=1) D
  1. ..S LIFE2=LIFE2+(LIFE2/4)
  1. .S LIFESTR2=(LIFE2*100)/14
  1. I (WORKING'="true") S LIFESTR2="N/A",FLAG=1
  1. ; One missing participation score
  1. I (PARTM=1) D
  1. .S PART=PART+(PART/8)
  1. S PARTSTR=((PART*100)/24)
  1. Q
  1. ;
  1. STRING ;
  1. I '$D(^TMP($J,"YSCOR")) D Q
  1. .S STRING1="| "_YSINSNAM_" score could not be determined. "
  1. ;
  1. S COGSTR=$P($G(^TMP($J,"YSCOR",2)),"=",2)
  1. S MOBILSTR=$P($G(^TMP($J,"YSCOR",3)),"=",2)
  1. S SELFSTR=$P($G(^TMP($J,"YSCOR",4)),"=",2)
  1. S ALONGSTR=$P($G(^TMP($J,"YSCOR",5)),"=",2)
  1. S LIFESTR1=$P($G(^TMP($J,"YSCOR",6)),"=",2)
  1. S LIFESTR2=$P($G(^TMP($J,"YSCOR",7)),"=",2)
  1. S PARTSTR=$P($G(^TMP($J,"YSCOR",8)),"=",2)
  1. S TOTAL=$P($G(^TMP($J,"YSCOR",9)),"=",2)
  1. ;
  1. S STRING="|| WHO Disability Assessment Schedule Domains "
  1. ; Using $P vs. $J because $J rounds upward and we need exact
  1. ;
  1. S STRING=STRING_"| Cognition: "_COGSTR
  1. S STRING=STRING_"| Mobility: "_MOBILSTR
  1. S STRING=STRING_"| Self-care: "_SELFSTR
  1. S STRING=STRING_"| Getting along: "_ALONGSTR
  1. S STRING=STRING_"| Life activities (household): "_LIFESTR1
  1. S STRING=STRING_"| Life activities (work/school): "_LIFESTR2
  1. S STRING=STRING_"| Participation: "_PARTSTR
  1. S STRING=STRING_"| Summary: "_TOTAL
  1. S STRING=STRING_"|| Range is 0 to 100 where 0 indicates no disability and 100 means full disability."
  1. Q
  1. ;
  1. TOTAL ;
  1. I WORKING="true" D Q
  1. . S TOTAL=(((COG+MOBIL+SELF+ALONG+LIFE1+LIFE2+PART)*100)/106)
  1. S TOTAL=(((COG+MOBIL+SELF+ALONG+LIFE1+PART)*100)/92)
  1. Q
  1. SCORESV ;
  1. I $D(^TMP($J,"YSG",1)),^TMP($J,"YSG",1)="[ERROR]" D Q ;-->out
  1. .K ^TMP($J,"YSCOR")
  1. .S ^TMP($J,"YSCOR",1)="[ERROR]"
  1. .S ^TMP($J,"YSCOR",2)="No Scale found for ADMIN: "_YS("AD")
  1. ;
  1. K ^TMP($J,"YSCOR")
  1. K ^TMP($J,"YSCOR") S YSDATA=$NA(^TMP($J,"YSCOR"))
  1. S ^TMP($J,"YSCOR",1)="[DATA]"
  1. S ^TMP($J,"YSCOR",2)=$$GET1^DIQ(601.87,634_",",3,"I")_"="_$P(COGSTR,".",1)
  1. S ^TMP($J,"YSCOR",3)=$$GET1^DIQ(601.87,635_",",3,"I")_"="_$P(MOBILSTR,".",1)
  1. S ^TMP($J,"YSCOR",4)=$$GET1^DIQ(601.87,636_",",3,"I")_"="_$P(SELFSTR,".",1)
  1. S ^TMP($J,"YSCOR",5)=$$GET1^DIQ(601.87,637_",",3,"I")_"="_$P(ALONGSTR,".",1)
  1. S ^TMP($J,"YSCOR",6)=$$GET1^DIQ(601.87,638_",",3,"I")_"="_$P(LIFESTR1,".",1)
  1. S ^TMP($J,"YSCOR",7)=$$GET1^DIQ(601.87,639_",",3,"I")_"="_$S(LIFESTR2="N/A":"N/A",1:$P(LIFESTR2,".",1))
  1. S ^TMP($J,"YSCOR",8)=$$GET1^DIQ(601.87,640_",",3,"I")_"="_$P(PARTSTR,".",1)
  1. S ^TMP($J,"YSCOR",9)=$$GET1^DIQ(601.87,641_",",3,"I")_"="_$P(TOTAL,".",1)
  1. Q
  1. ;
  1. DLLSTR(YSDATA,YS,YSTRNG) ;
  1. ; YSTRNG = 1 Score Instrument
  1. ; YSTRNG = 2 get Report Answers and Text
  1. N DATA,DES,NODE,LEG,YSCDA,YSQN,YSINSNAM,YSSEQ
  1. N STRING,STRING1,TOTAL
  1. N COG,MOBIL,SELF,ALONG,LIFE1,LIFE2,PART,WORKING
  1. N COGM,MOBILM,SELFM,ALONGM,LIFE1M,LIFE2M,PARTM
  1. N COGSTR,MOBILSTR,SELFSTR,ALONGSTR,LIFESTR1,LIFESTR2,PARTSTR
  1. N FLAG
  1. ;
  1. S (DES,STRING,STRING1)=""
  1. S FLAG=0,WORKING=""
  1. S (COG,MOBIL,SELF,ALONG,LIFE1,LIFE2,PART,TOTAL)=0
  1. S (COGM,MOBILM,SELFM,ALONGM,LIFE1M,LIFE2M,PARTM)=0
  1. S (COGSTR,MOBILSTR,SELFSTR,ALONGSTR,LIFESTR1,LIFESTR2,PARTSTR)=0
  1. ;
  1. D DATA1
  1. D CALCS
  1. I YSTRNG=1 D
  1. .D TOTAL
  1. .D SCORESV
  1. I YSTRNG=2 D
  1. .D LDSCORES^YTSCORE(.YSDATA,.YS)
  1. .D STRING
  1. .S YSDATA($O(YSDATA(""),-1)+1)=999999999999_U_U_STRING Q
  1. Q