YTSWHOQO ;SLC/DJE- ANSWERS SPECIAL HANDLING - WHOQOL-BREF ; 10/16/18 9:35am
;;5.01;MENTAL HEALTH;**151**;DEC 30,1994;Build 92
;
DATA1(SCORE) ;expects YSDATA, returns SCORE, multiple scales so we use nodes i.e. SCORE(SCALEIEN)=###
;specialized DATA1 uses SCOREDATA table to map question to score relationships
N LINE,TEXT,SKIP,SCALE,RAW,NEWVAL,I,TRANSFORM
F LINE=1:1 S TEXT=$P($T(SCOREDAT+LINE),";",2) Q:TEXT="QUIT" D
.N RAWTYPE,QUESTIONS,I
.S SCALE=$P(TEXT,"|",1) S RAWTYPE=$P(TEXT,"|",2) S QUESTIONS=$P(TEXT,"|",3)
.F I=1:1:$L(QUESTIONS,U) D
..N NODE,DATA
..S NODE=$P(QUESTIONS,U,I)+2 ;YSDATA question nodes start at 3
..S DATA=YSDATA(NODE)
..;retrieval method section. For each RAWTYPE assign a value to RAW
..;typical case, YSDATA piece 3 has the MH CHOICE IEN and raw value is in LEGACY field
..I RAWTYPE="LEGACY" S RAW=$$GET1^DIQ(601.75,$P($G(DATA),U,3)_",",4,"I")
..I RAW="X" S SKIP(SCALE)=$G(SKIP(SCALE))+1 ;Need to keep count of skipped questions
..S SCORE(SCALE)=$G(SCORE(SCALE))+RAW
;
;logic to handle skipped questions.
S SCALE=""
F S SCALE=$O(SKIP(SCALE)) Q:SCALE="" D
.I SCALE=884 D Q
..I SKIP(884)>1 S SCORE(884)="" Q
..S RAW=SCORE(884)
..S NEWVAL=RAW/6,RAW=RAW+$FN(NEWVAL,"",0) ;set missing value to average of others
..S SCORE(884)=RAW
.;
.I SCALE=885 S SCORE(885)="" Q
.;
.I SCALE=886 S SCORE(886)="" Q
.;
.I SCALE=887 D Q
..I SKIP(887)>1 S SCORE(887)="" Q
..S RAW=SCORE(887)
..S NEWVAL=RAW/6,RAW=RAW+$FN(NEWVAL,"",0) ;set missing value to average of others
..S SCORE(887)=RAW
;
;logic for t-scores
F I=1:1:4 D ;Only 4 scales have transformed scores
.S RAW=SCORE(883+I) ;1 to 4 -> 884 to 887
.I RAW="" Q
.S TRANSFORM=$$GETTRANS(RAW,I)
.S SCORE(883+I)=RAW_U_TRANSFORM
;
Q
;
;SCOREDATA maps questions to their scale and to the method we use to retrieve the raw value.
;A scale can have multiple lines and does not need to match the scalegroup order
;You can create your own RAW RETRIEVAL METHOD, just make sure we handle the case in DATA1
SCOREDAT ; SCALE IEN|RAW RETRIEVAL METHOD|QUES#^QUES#...
;1307|LEGACY|1
;1308|LEGACY|2
;884|LEGACY|3^4^10^15^16^17^18
;885|LEGACY|5^6^7^11^19^26
;886|LEGACY|20^21^22
;887|LEGACY|8^9^12^13^14^23^24^25
;QUIT
Q
;
SCORESV(SCORE) ;Expects SCORE to be in format SCORE(SCALE_IEN)=###. Also expects ^TMP($J,"YSG")
N YSCORNODE,YSGNODE
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"
;
K ^TMP($J,"YSCOR")
S ^TMP($J,"YSCOR",1)="[DATA]"
S YSCORNODE=2
S YSGNODE=2 F S YSGNODE=$O(^TMP($J,"YSG",YSGNODE)) Q:YSGNODE="" D
.N SCALEIEN
.I $E(^TMP($J,"YSG",YSGNODE),1,5)'="Scale" Q ;only read the lines for scales
.S SCALEIEN=+$P(^TMP($J,"YSG",YSGNODE),"=",2) ;grab the first number after "=" sign
.S ^TMP($J,"YSCOR",YSCORNODE)=$$GET1^DIQ(601.87,SCALEIEN_",",3,"I")_"="_SCORE(SCALEIEN)
.S YSCORNODE=YSCORNODE+1
;
Q
;
DLLSTR(YSDATA,YS,YSTRNG) ;
; YSTRNG = 1 Score Instrument
; YSTRNG = 2 get Report Answers and Text
N SCORE,TSARR
;
I YSTRNG=1 D DATA1(.SCORE),SCORESV(.SCORE)
;LDSCORES is not retrieving t-scores for TMP($J,"YSCOR") so we need to run LDTSCOR.
I YSTRNG=2 D LDTSCOR^YTSCORE(.TSARR,YS("AD")),BUILDANS(.TSARR,.YSDATA)
Q
;
BUILDANS(TSARR,YSDATA) ;
N SCORE,I
S N=N+1
;
S YSDATA(N)="7771^9999;1^"_$P(TSARR("QoL"),U,2),N=N+1
S YSDATA(N)="7772^9999;1^"_$P(TSARR("GenHealth"),U,2),N=N+1
;
S I=3
F SCORE="PhyHealth","Psy","SocRel","Envi" D
.N TEXT,RAW,TRANSFORM
.D ;do domains with transformed
..S RAW=$P(TSARR(SCORE),U,2)
..I RAW="" S TEXT="-- --" D Q
..S TRANSFORM=$P(TSARR(SCORE),U,3)
..S TEXT=RAW_" "_TRANSFORM
.S YSDATA(N)="777"_I_"^9999;1^"_TEXT,N=N+1,I=I+1
;
Q
;
GETTRANS(RAW,SCOREIDX) ; get the transformed score given a score's raw #
N TEXT,LOW,RANGE,RETURN
S TEXT=$P($T(TABLE+SCOREIDX),U,2)
I TEXT="" Q ""
S LOW=$P(TEXT,"|"),RANGE=$P(TEXT,"|",2)
S RETURN=((RAW-LOW)/RANGE)*100
S RETURN=$FN(RETURN,"",0) ;$P(RETURN,".")
Q RETURN
;
TABLE ; Transform scores data Score^low score|range
; Domain 1 Physical Health^7|28
; Domain 2 Psychological^6|24
; Domain 3 Social Relationships^3|12
; Domain 4 Environment^8|32
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTSWHOQO 4372 printed Apr 09, 2024@21:14:59 Page 2
YTSWHOQO ;SLC/DJE- ANSWERS SPECIAL HANDLING - WHOQOL-BREF ; 10/16/18 9:35am
+1 ;;5.01;MENTAL HEALTH;**151**;DEC 30,1994;Build 92
+2 ;
DATA1(SCORE) ;expects YSDATA, returns SCORE, multiple scales so we use nodes i.e. SCORE(SCALEIEN)=###
+1 ;specialized DATA1 uses SCOREDATA table to map question to score relationships
+2 NEW LINE,TEXT,SKIP,SCALE,RAW,NEWVAL,I,TRANSFORM
+3 FOR LINE=1:1
SET TEXT=$PIECE($TEXT(SCOREDAT+LINE),";",2)
if TEXT="QUIT"
QUIT
Begin DoDot:1
+4 NEW RAWTYPE,QUESTIONS,I
+5 SET SCALE=$PIECE(TEXT,"|",1)
SET RAWTYPE=$PIECE(TEXT,"|",2)
SET QUESTIONS=$PIECE(TEXT,"|",3)
+6 FOR I=1:1:$LENGTH(QUESTIONS,U)
Begin DoDot:2
+7 NEW NODE,DATA
+8 ;YSDATA question nodes start at 3
SET NODE=$PIECE(QUESTIONS,U,I)+2
+9 SET DATA=YSDATA(NODE)
+10 ;retrieval method section. For each RAWTYPE assign a value to RAW
+11 ;typical case, YSDATA piece 3 has the MH CHOICE IEN and raw value is in LEGACY field
+12 IF RAWTYPE="LEGACY"
SET RAW=$$GET1^DIQ(601.75,$PIECE($GET(DATA),U,3)_",",4,"I")
+13 ;Need to keep count of skipped questions
IF RAW="X"
SET SKIP(SCALE)=$GET(SKIP(SCALE))+1
+14 SET SCORE(SCALE)=$GET(SCORE(SCALE))+RAW
End DoDot:2
End DoDot:1
+15 ;
+16 ;logic to handle skipped questions.
+17 SET SCALE=""
+18 FOR
SET SCALE=$ORDER(SKIP(SCALE))
if SCALE=""
QUIT
Begin DoDot:1
+19 IF SCALE=884
Begin DoDot:2
+20 IF SKIP(884)>1
SET SCORE(884)=""
QUIT
+21 SET RAW=SCORE(884)
+22 ;set missing value to average of others
SET NEWVAL=RAW/6
SET RAW=RAW+$FNUMBER(NEWVAL,"",0)
+23 SET SCORE(884)=RAW
End DoDot:2
QUIT
+24 ;
+25 IF SCALE=885
SET SCORE(885)=""
QUIT
+26 ;
+27 IF SCALE=886
SET SCORE(886)=""
QUIT
+28 ;
+29 IF SCALE=887
Begin DoDot:2
+30 IF SKIP(887)>1
SET SCORE(887)=""
QUIT
+31 SET RAW=SCORE(887)
+32 ;set missing value to average of others
SET NEWVAL=RAW/6
SET RAW=RAW+$FNUMBER(NEWVAL,"",0)
+33 SET SCORE(887)=RAW
End DoDot:2
QUIT
End DoDot:1
+34 ;
+35 ;logic for t-scores
+36 ;Only 4 scales have transformed scores
FOR I=1:1:4
Begin DoDot:1
+37 ;1 to 4 -> 884 to 887
SET RAW=SCORE(883+I)
+38 IF RAW=""
QUIT
+39 SET TRANSFORM=$$GETTRANS(RAW,I)
+40 SET SCORE(883+I)=RAW_U_TRANSFORM
End DoDot:1
+41 ;
+42 QUIT
+43 ;
+44 ;SCOREDATA maps questions to their scale and to the method we use to retrieve the raw value.
+45 ;A scale can have multiple lines and does not need to match the scalegroup order
+46 ;You can create your own RAW RETRIEVAL METHOD, just make sure we handle the case in DATA1
SCOREDAT ; SCALE IEN|RAW RETRIEVAL METHOD|QUES#^QUES#...
+1 ;1307|LEGACY|1
+2 ;1308|LEGACY|2
+3 ;884|LEGACY|3^4^10^15^16^17^18
+4 ;885|LEGACY|5^6^7^11^19^26
+5 ;886|LEGACY|20^21^22
+6 ;887|LEGACY|8^9^12^13^14^23^24^25
+7 ;QUIT
+8 QUIT
+9 ;
SCORESV(SCORE) ;Expects SCORE to be in format SCORE(SCALE_IEN)=###. Also expects ^TMP($J,"YSG")
+1 NEW YSCORNODE,YSGNODE
+2 ;-->out
IF $DATA(^TMP($JOB,"YSG",1))
IF ^TMP($JOB,"YSG",1)="[ERROR]"
Begin DoDot:1
+3 KILL ^TMP($JOB,"YSCOR")
+4 SET ^TMP($JOB,"YSCOR",1)="[ERROR]"
+5 SET ^TMP($JOB,"YSCOR",2)="No Scale found for ADMIN"
End DoDot:1
QUIT
+6 ;
+7 KILL ^TMP($JOB,"YSCOR")
+8 SET ^TMP($JOB,"YSCOR",1)="[DATA]"
+9 SET YSCORNODE=2
+10 SET YSGNODE=2
FOR
SET YSGNODE=$ORDER(^TMP($JOB,"YSG",YSGNODE))
if YSGNODE=""
QUIT
Begin DoDot:1
+11 NEW SCALEIEN
+12 ;only read the lines for scales
IF $EXTRACT(^TMP($JOB,"YSG",YSGNODE),1,5)'="Scale"
QUIT
+13 ;grab the first number after "=" sign
SET SCALEIEN=+$PIECE(^TMP($JOB,"YSG",YSGNODE),"=",2)
+14 SET ^TMP($JOB,"YSCOR",YSCORNODE)=$$GET1^DIQ(601.87,SCALEIEN_",",3,"I")_"="_SCORE(SCALEIEN)
+15 SET YSCORNODE=YSCORNODE+1
End DoDot:1
+16 ;
+17 QUIT
+18 ;
DLLSTR(YSDATA,YS,YSTRNG) ;
+1 ; YSTRNG = 1 Score Instrument
+2 ; YSTRNG = 2 get Report Answers and Text
+3 NEW SCORE,TSARR
+4 ;
+5 IF YSTRNG=1
DO DATA1(.SCORE)
DO SCORESV(.SCORE)
+6 ;LDSCORES is not retrieving t-scores for TMP($J,"YSCOR") so we need to run LDTSCOR.
+7 IF YSTRNG=2
DO LDTSCOR^YTSCORE(.TSARR,YS("AD"))
DO BUILDANS(.TSARR,.YSDATA)
+8 QUIT
+9 ;
BUILDANS(TSARR,YSDATA) ;
+1 NEW SCORE,I
+2 SET N=N+1
+3 ;
+4 SET YSDATA(N)="7771^9999;1^"_$PIECE(TSARR("QoL"),U,2)
SET N=N+1
+5 SET YSDATA(N)="7772^9999;1^"_$PIECE(TSARR("GenHealth"),U,2)
SET N=N+1
+6 ;
+7 SET I=3
+8 FOR SCORE="PhyHealth","Psy","SocRel","Envi"
Begin DoDot:1
+9 NEW TEXT,RAW,TRANSFORM
+10 ;do domains with transformed
Begin DoDot:2
+11 SET RAW=$PIECE(TSARR(SCORE),U,2)
+12 IF RAW=""
SET TEXT="-- --"
Begin DoDot:3
End DoDot:3
QUIT
+13 SET TRANSFORM=$PIECE(TSARR(SCORE),U,3)
+14 SET TEXT=RAW_" "_TRANSFORM
End DoDot:2
+15 SET YSDATA(N)="777"_I_"^9999;1^"_TEXT
SET N=N+1
SET I=I+1
End DoDot:1
+16 ;
+17 QUIT
+18 ;
GETTRANS(RAW,SCOREIDX) ; get the transformed score given a score's raw #
+1 NEW TEXT,LOW,RANGE,RETURN
+2 SET TEXT=$PIECE($TEXT(TABLE+SCOREIDX),U,2)
+3 IF TEXT=""
QUIT ""
+4 SET LOW=$PIECE(TEXT,"|")
SET RANGE=$PIECE(TEXT,"|",2)
+5 SET RETURN=((RAW-LOW)/RANGE)*100
+6 ;$P(RETURN,".")
SET RETURN=$FNUMBER(RETURN,"",0)
+7 QUIT RETURN
+8 ;
TABLE ; Transform scores data Score^low score|range
+1 ; Domain 1 Physical Health^7|28
+2 ; Domain 2 Psychological^6|24
+3 ; Domain 3 Social Relationships^3|12
+4 ; Domain 4 Environment^8|32
+5 ;
