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