YTSQOLI ;SLC/PIJ - Score QOLI ; 01/08/2016
;;5.01;MENTAL HEALTH;**123,142,141**;DEC 30,1994;Build 85
;
;Public, Supported ICRs
; #2056 - Fileman API - $$GET1^DIQ
;
Q
;
DATA1 ;
N RAWSCORE
S RAWSCORE=0
S YSINSNAM=$P($G(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 YSCDA=$P($G(DATA),U,3)
.D DESGNTR^YTSCORE(YSQN,.DES)
.S LEG=$$GET1^DIQ(601.75,YSCDA_",",4,"I")
.I (YSCDA=1155)!(YSCDA=1156) S LEG=1155 ; Skipped
.I YSCDA=3131 S LEG=0 ; Not Important
.I YSCDA=3132 S LEG=1 ; Important
.I YSCDA=3133 S LEG=2 ; Extremely Important
.I YSCDA=1718 S LEG=0 ; S LEG=-3 ; Very dissatisfied (prior to 139)
.I YSCDA=4110 S LEG=0 ; S LEG=-3 ; Very dissatisfied
.I YSCDA=2357 S LEG=1 ; S LEG=-2 ; Somewhat dissatisfied
.I YSCDA=3134 S LEG=2 ; S LEG=-1 ; A little dissatisfied
.I YSCDA=3135 S LEG=3 ; S LEG=1 ; A little satisfied
.I YSCDA=2356 S LEG=4 ; S LEG=2 ; Somewhat satisfied
.I YSCDA=1714 S LEG=5 ; S LEG=3 ; Very satisfied (prior to 139)
.I YSCDA=4109 S LEG=5 ; S LEG=3 ; Very satisfied
.D SCORANS
D SCORANS1
Q
;
STRING ;
S INDENT=" "
; The reason for the next 3 lines is that the QOLI calculation does not add zeros to the result
; e.g. the RAW score = .8, s/b 0.8
I (RAW="-.0")!(RAW="0.0") S RAW=0
;
S TSCORE=$$GETTSCOR^YTSQOLI1(RAW,WGHTSAT0,WGHTSAT99)
S SCORESTR=$$GETPSCOR^YTSQOLI1(RAW,WGHTSAT0,WGHTSAT99)
F I=1:1:TSCORE S TSCORBAR=TSCORBAR_"*"
;
S STRING=STRING_INDENT_"||(Raw Score: "_RAW_")"
S STRING=STRING_INDENT_"| T Score: "_TSCORE
S STRING=STRING_INDENT_"|(%ile Score: "_SCORESTR_")"
S STRING=STRING_INDENT_"||Overall Quality of Life"
S STRING=STRING_INDENT_"|| VERY LOW LOW AVERAGE HIGH"
S STRING=STRING_INDENT_"|-----------------------------------------------------------------------------"
S STRING=STRING_INDENT_"|"_TSCORBAR
S STRING=STRING_INDENT_"|-----------------------------------------------------------------------------"
S STRING=STRING_INDENT_"|: : : : :"
S STRING=STRING_INDENT_"|0 37 43 58 77"
S STRING=STRING_INDENT_"|||Weighted Satisfaction Profile"
S STRING=STRING_INDENT_"|| DISSATISFACTION SATISFACTION"
S STRING=STRING_INDENT_"| -6 -4 -3 -2 -1 0 1 2 3 4 6"
S STRING=STRING_INDENT_"| ---------------------------------------------"
;
D PADINFO("Health",SCALE(1))
D PADINFO("Self-Esteem",SCALE(2))
D PADINFO("Goals-and-Values",SCALE(3))
D PADINFO("Money",SCALE(4))
D PADINFO("Work",SCALE(5))
D PADINFO("Play",SCALE(6))
D PADINFO("Learning",SCALE(7))
D PADINFO("Creativity",SCALE(8))
D PADINFO("Helping",SCALE(9))
D PADINFO("Love",SCALE(10))
D PADINFO("Friends",SCALE(11))
D PADINFO("Children",SCALE(12))
D PADINFO("Relatives",SCALE(13))
D PADINFO("Home",SCALE(14))
D PADINFO("Neighborhood",SCALE(15))
D PADINFO("Community",SCALE(16))
;
S STRING=STRING_INDENT_"| ---------------------------------------------"
S STRING=STRING_INDENT_"| -6 -4 -3 -2 -1 0 1 2 3 4 6"
;
S STRING=STRING_"||||"_INDENT_"|The following weighted satisfaction ratings indicate areas of dissatisfaction"
S STRING=STRING_"|for this person:"
S STRING=STRING_"||"_INDENT_" Weighted "
S STRING=STRING_"|Area Satisfaction Rating"
S STRING=STRING_"|---- -------------------"
D SORTSAT^YTSQOLI1
;
S STRING=STRING_"|||OMITTED ITEMS"
I OMITITEM'="" S STRING=STRING_"|"_INDENT_$E(OMITITEM,1,$L(OMITITEM)-1)
I OMITITEM="" S STRING=STRING_"|"_INDENT_"None omitted"
; Response summary, but first convert any response of -99 to ''
S STRING=STRING_"||ITEM RESPONSES|"
S STRING=STRING_"|"
;
F I=1:1:9 S STRING=STRING_" "_$P(RESPONSE,"|",I)_INDENT
S STRING=STRING_" "_$P(RESPONSE,"|",10)_"|"
F I=11:1:19 S STRING=STRING_$P(RESPONSE,"|",I)_INDENT
S STRING=STRING_" "_$P(RESPONSE,"|",20)_"|"
F I=21:1:29 S STRING=STRING_$P(RESPONSE,"|",I)_INDENT
S STRING=STRING_" "_$P(RESPONSE,"|",30)_"|"
F I=31:1:32 S STRING=STRING_$P(RESPONSE,"|",I)_INDENT
S STRING=STRING_"|"
Q
;
PADINFO(NAME,SC) ;
N I,PAD,PAD1,SP,Z,Z1
S (PAD,PAD1,SP,Z,Z1)=""
F I=1:1:(16-$L(NAME)) S SP=SP_" "
S PAD=$S(SC="-6":2,SC="-4":6,SC="-3":10,SC="-2":14,SC="-1":18,SC="0":22,SC="1":26,SC="2":30,SC="3":34,SC="4":38,SC="6":42,1:"")
F I=1:1:PAD S Z=Z_" "
S PAD1=61-($L(SP)+$L(NAME)+$L(Z)+1)
F I=1:1:PAD1 S Z1=Z1_" "
S STRING=STRING_"|"_SP_NAME_":"_Z_"*"_Z1_":"_NAME
Q
;
SCORANS ;
S TMPRSLT=LEG
S TMPANS=YSCDA
S (RESULT)=""
;
; must convert entered response of 1 (itemindex=0) to 1 for display
S ITEMSCOR(DES)=$S(TMPRSLT=0:1,TMPRSLT=1:2,TMPRSLT=2:3,TMPRSLT=3:4,TMPRSLT=4:5,TMPRSLT=5:6,1:"")
;
; no conversion yet, itemIndex will be non negative, if unanswered
I (TMPANS=1155) D
.S TMPSCALE(DES)="-99"
.S OMITITEM=OMITITEM_DES_","
E D
.S TMPSCALE(DES)=TMPRSLT ; TMPANS
; need to have a 2nd question before can do any calculations
I (DES=1) S RESPONSE=RESPONSE_DES_":"_ITEMSCOR(DES)_"|" Q
; getting even numbered questions, satisfaction rating, needs conversion
; importance rating does not need any conversion.
I (DES#2)=0 D
.S TMPSCALE(DES)=$S(TMPSCALE(DES)=0:"-3",TMPSCALE(DES)=1:"-2",TMPSCALE(DES)=2:"-1",TMPSCALE(DES)=3:"1",TMPSCALE(DES)=4:"2",TMPSCALE(DES)=5:"3",1:TMPSCALE(DES))
.; compute the scale, -99 = unendorsed
.I (DES=26),(TMPSCALE(DES-1)=0),(TMPSCALE(DES)="-99") D
..S SCALE(DES/2)=0
.; else if
.E D
..I (TMPSCALE(DES-1)="-99")!(TMPSCALE(DES)="-99") D
...S SCALE(DES/2)="-99"
..E D
...S SCALE(DES/2)=(TMPSCALE(DES-1)*TMPSCALE(DES))
.; compute the raw score and determine if a valid importance item (odd # question)
.I SCALE(DES/2)'="-99" D
..S RAWSCORE=RAWSCORE+(SCALE(DES/2))
..I (TMPSCALE(DES-1)>0) S VALIDSCR=VALIDSCR+1
.; used to compute invalid percentile score
.I SCALE(DES/2)=0 S WGHTSAT0=WGHTSAT0+1
.I SCALE(DES/2)="-99" S WGHTSAT99=WGHTSAT99+1
;collect value of all individual questions with the value entered
S RESPONSE=RESPONSE_DES_":"_ITEMSCOR(DES)_"|"
Q
;
SCORANS1 ;
; compute rawScore
I (VALIDSCR=0) S RAWSCORE="0.05"
I (VALIDSCR'=0) S RAWSCORE=$J(((RAWSCORE/VALIDSCR)+.05),0,1)
S RAW=$P(RAWSCORE,".",1)_"."_$E($P(RAWSCORE,".",2),0,1)
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)=YSINSNAM_" Scale not found"
;
K ^TMP($J,"YSCOR")
S ^TMP($J,"YSCOR",1)="[DATA]"
S ^TMP($J,"YSCOR",2)=$$GET1^DIQ(601.87,762_",",3,"I")_"="_SCALE("1")
S ^TMP($J,"YSCOR",3)=$$GET1^DIQ(601.87,763_",",3,"I")_"="_SCALE("2")
S ^TMP($J,"YSCOR",4)=$$GET1^DIQ(601.87,764_",",3,"I")_"="_SCALE("3")
S ^TMP($J,"YSCOR",5)=$$GET1^DIQ(601.87,765_",",3,"I")_"="_SCALE("4")
S ^TMP($J,"YSCOR",6)=$$GET1^DIQ(601.87,766_",",3,"I")_"="_SCALE("5")
S ^TMP($J,"YSCOR",7)=$$GET1^DIQ(601.87,767_",",3,"I")_"="_SCALE("6")
S ^TMP($J,"YSCOR",8)=$$GET1^DIQ(601.87,768_",",3,"I")_"="_SCALE("7")
S ^TMP($J,"YSCOR",9)=$$GET1^DIQ(601.87,769_",",3,"I")_"="_SCALE("8")
S ^TMP($J,"YSCOR",10)=$$GET1^DIQ(601.87,770_",",3,"I")_"="_SCALE("9")
S ^TMP($J,"YSCOR",11)=$$GET1^DIQ(601.87,771_",",3,"I")_"="_SCALE("10")
S ^TMP($J,"YSCOR",12)=$$GET1^DIQ(601.87,772_",",3,"I")_"="_SCALE("11")
S ^TMP($J,"YSCOR",13)=$$GET1^DIQ(601.87,773_",",3,"I")_"="_SCALE("12")
S ^TMP($J,"YSCOR",14)=$$GET1^DIQ(601.87,774_",",3,"I")_"="_SCALE("13")
S ^TMP($J,"YSCOR",15)=$$GET1^DIQ(601.87,775_",",3,"I")_"="_SCALE("14")
S ^TMP($J,"YSCOR",16)=$$GET1^DIQ(601.87,776_",",3,"I")_"="_SCALE("15")
S ^TMP($J,"YSCOR",17)=$$GET1^DIQ(601.87,777_",",3,"I")_"="_SCALE("16")
Q
;
DLLSTR(YSDATA,YS,YSTRNG) ;
; YSTRNG = 1 Score Instrument
; YSTRNG = 2 get Report Answers and Text
N DATA,DES,I,NODE,LEG,YSQN,YSCDA,INDENT,TMPANS
N YSINSNAM,ITEMSCOR,SCALE,TMPSCALE
N TMPRSLT,VALIDSCR
N SCORESTR,TSCORBAR,TSCORE,OMITTED,FLAG
N OMITITEM,RESPONSE,STRING,STRING1
N PROTECT,USE,RISK,RESULT
N RAW,WGHTSAT0,WGHTSAT99
;
S (TSCORE,SCORESTR,VALIDSCR)=0
S (OMITTED,TSCORBAR)=""
;
F I=1:1:32 S TMPSCALE(I)=0
F I=1:1:32 S ITEMSCOR(I)=""
F I=1:1:16 S SCALE(I)=0,SCALE(I_"."_5)=0
;
S (OMITITEM,RESPONSE,STRING,STRING1)=""
S (PROTECT,USE,RISK)=0
S (RAW,WGHTSAT0,WGHTSAT99)=0
S TMPRSLT=0
;
D DATA1
;
I YSTRNG=1 D SCORESV
;
I YSTRNG=2 D
.D LDSCORES^YTSCORE(.YSDATA,.YS)
.D STRING
.S YSDATA($O(YSDATA(""),-1)+1)=999999999999_U_U_STRING
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTSQOLI 8825 printed Dec 13, 2024@02:20:43 Page 2
YTSQOLI ;SLC/PIJ - Score QOLI ; 01/08/2016
+1 ;;5.01;MENTAL HEALTH;**123,142,141**;DEC 30,1994;Build 85
+2 ;
+3 ;Public, Supported ICRs
+4 ; #2056 - Fileman API - $$GET1^DIQ
+5 ;
+6 QUIT
+7 ;
DATA1 ;
+1 NEW RAWSCORE
+2 SET RAWSCORE=0
+3 SET YSINSNAM=$PIECE($GET(YSDATA(2)),U,3)
+4 IF $GET(YSINSNAM)=""
SET YSINSNAM=$GET(YS("CODE"),"NO NAME PASSED")
+5 SET NODE=2
FOR
SET NODE=$ORDER(YSDATA(NODE))
if NODE=""
QUIT
Begin DoDot:1
+6 SET DATA=YSDATA(NODE)
+7 SET YSQN=$PIECE(DATA,U,1)
+8 SET YSCDA=$PIECE($GET(DATA),U,3)
+9 DO DESGNTR^YTSCORE(YSQN,.DES)
+10 SET LEG=$$GET1^DIQ(601.75,YSCDA_",",4,"I")
+11 ; Skipped
IF (YSCDA=1155)!(YSCDA=1156)
SET LEG=1155
+12 ; Not Important
IF YSCDA=3131
SET LEG=0
+13 ; Important
IF YSCDA=3132
SET LEG=1
+14 ; Extremely Important
IF YSCDA=3133
SET LEG=2
+15 ; S LEG=-3 ; Very dissatisfied (prior to 139)
IF YSCDA=1718
SET LEG=0
+16 ; S LEG=-3 ; Very dissatisfied
IF YSCDA=4110
SET LEG=0
+17 ; S LEG=-2 ; Somewhat dissatisfied
IF YSCDA=2357
SET LEG=1
+18 ; S LEG=-1 ; A little dissatisfied
IF YSCDA=3134
SET LEG=2
+19 ; S LEG=1 ; A little satisfied
IF YSCDA=3135
SET LEG=3
+20 ; S LEG=2 ; Somewhat satisfied
IF YSCDA=2356
SET LEG=4
+21 ; S LEG=3 ; Very satisfied (prior to 139)
IF YSCDA=1714
SET LEG=5
+22 ; S LEG=3 ; Very satisfied
IF YSCDA=4109
SET LEG=5
+23 DO SCORANS
End DoDot:1
+24 DO SCORANS1
+25 QUIT
+26 ;
STRING ;
+1 SET INDENT=" "
+2 ; The reason for the next 3 lines is that the QOLI calculation does not add zeros to the result
+3 ; e.g. the RAW score = .8, s/b 0.8
+4 IF (RAW="-.0")!(RAW="0.0")
SET RAW=0
+5 ;
+6 SET TSCORE=$$GETTSCOR^YTSQOLI1(RAW,WGHTSAT0,WGHTSAT99)
+7 SET SCORESTR=$$GETPSCOR^YTSQOLI1(RAW,WGHTSAT0,WGHTSAT99)
+8 FOR I=1:1:TSCORE
SET TSCORBAR=TSCORBAR_"*"
+9 ;
+10 SET STRING=STRING_INDENT_"||(Raw Score: "_RAW_")"
+11 SET STRING=STRING_INDENT_"| T Score: "_TSCORE
+12 SET STRING=STRING_INDENT_"|(%ile Score: "_SCORESTR_")"
+13 SET STRING=STRING_INDENT_"||Overall Quality of Life"
+14 SET STRING=STRING_INDENT_"|| VERY LOW LOW AVERAGE HIGH"
+15 SET STRING=STRING_INDENT_"|-----------------------------------------------------------------------------"
+16 SET STRING=STRING_INDENT_"|"_TSCORBAR
+17 SET STRING=STRING_INDENT_"|-----------------------------------------------------------------------------"
+18 SET STRING=STRING_INDENT_"|: : : : :"
+19 SET STRING=STRING_INDENT_"|0 37 43 58 77"
+20 SET STRING=STRING_INDENT_"|||Weighted Satisfaction Profile"
+21 SET STRING=STRING_INDENT_"|| DISSATISFACTION SATISFACTION"
+22 SET STRING=STRING_INDENT_"| -6 -4 -3 -2 -1 0 1 2 3 4 6"
+23 SET STRING=STRING_INDENT_"| ---------------------------------------------"
+24 ;
+25 DO PADINFO("Health",SCALE(1))
+26 DO PADINFO("Self-Esteem",SCALE(2))
+27 DO PADINFO("Goals-and-Values",SCALE(3))
+28 DO PADINFO("Money",SCALE(4))
+29 DO PADINFO("Work",SCALE(5))
+30 DO PADINFO("Play",SCALE(6))
+31 DO PADINFO("Learning",SCALE(7))
+32 DO PADINFO("Creativity",SCALE(8))
+33 DO PADINFO("Helping",SCALE(9))
+34 DO PADINFO("Love",SCALE(10))
+35 DO PADINFO("Friends",SCALE(11))
+36 DO PADINFO("Children",SCALE(12))
+37 DO PADINFO("Relatives",SCALE(13))
+38 DO PADINFO("Home",SCALE(14))
+39 DO PADINFO("Neighborhood",SCALE(15))
+40 DO PADINFO("Community",SCALE(16))
+41 ;
+42 SET STRING=STRING_INDENT_"| ---------------------------------------------"
+43 SET STRING=STRING_INDENT_"| -6 -4 -3 -2 -1 0 1 2 3 4 6"
+44 ;
+45 SET STRING=STRING_"||||"_INDENT_"|The following weighted satisfaction ratings indicate areas of dissatisfaction"
+46 SET STRING=STRING_"|for this person:"
+47 SET STRING=STRING_"||"_INDENT_" Weighted "
+48 SET STRING=STRING_"|Area Satisfaction Rating"
+49 SET STRING=STRING_"|---- -------------------"
+50 DO SORTSAT^YTSQOLI1
+51 ;
+52 SET STRING=STRING_"|||OMITTED ITEMS"
+53 IF OMITITEM'=""
SET STRING=STRING_"|"_INDENT_$EXTRACT(OMITITEM,1,$LENGTH(OMITITEM)-1)
+54 IF OMITITEM=""
SET STRING=STRING_"|"_INDENT_"None omitted"
+55 ; Response summary, but first convert any response of -99 to ''
+56 SET STRING=STRING_"||ITEM RESPONSES|"
+57 SET STRING=STRING_"|"
+58 ;
+59 FOR I=1:1:9
SET STRING=STRING_" "_$PIECE(RESPONSE,"|",I)_INDENT
+60 SET STRING=STRING_" "_$PIECE(RESPONSE,"|",10)_"|"
+61 FOR I=11:1:19
SET STRING=STRING_$PIECE(RESPONSE,"|",I)_INDENT
+62 SET STRING=STRING_" "_$PIECE(RESPONSE,"|",20)_"|"
+63 FOR I=21:1:29
SET STRING=STRING_$PIECE(RESPONSE,"|",I)_INDENT
+64 SET STRING=STRING_" "_$PIECE(RESPONSE,"|",30)_"|"
+65 FOR I=31:1:32
SET STRING=STRING_$PIECE(RESPONSE,"|",I)_INDENT
+66 SET STRING=STRING_"|"
+67 QUIT
+68 ;
PADINFO(NAME,SC) ;
+1 NEW I,PAD,PAD1,SP,Z,Z1
+2 SET (PAD,PAD1,SP,Z,Z1)=""
+3 FOR I=1:1:(16-$LENGTH(NAME))
SET SP=SP_" "
+4 SET PAD=$SELECT(SC="-6":2,SC="-4":6,SC="-3":10,SC="-2":14,SC="-1":18,SC="0":22,SC="1":26,SC="2":30,SC="3":34,SC="4":38,SC="6":42,1:"")
+5 FOR I=1:1:PAD
SET Z=Z_" "
+6 SET PAD1=61-($LENGTH(SP)+$LENGTH(NAME)+$LENGTH(Z)+1)
+7 FOR I=1:1:PAD1
SET Z1=Z1_" "
+8 SET STRING=STRING_"|"_SP_NAME_":"_Z_"*"_Z1_":"_NAME
+9 QUIT
+10 ;
SCORANS ;
+1 SET TMPRSLT=LEG
+2 SET TMPANS=YSCDA
+3 SET (RESULT)=""
+4 ;
+5 ; must convert entered response of 1 (itemindex=0) to 1 for display
+6 SET ITEMSCOR(DES)=$SELECT(TMPRSLT=0:1,TMPRSLT=1:2,TMPRSLT=2:3,TMPRSLT=3:4,TMPRSLT=4:5,TMPRSLT=5:6,1:"")
+7 ;
+8 ; no conversion yet, itemIndex will be non negative, if unanswered
+9 IF (TMPANS=1155)
Begin DoDot:1
+10 SET TMPSCALE(DES)="-99"
+11 SET OMITITEM=OMITITEM_DES_","
End DoDot:1
+12 IF '$TEST
Begin DoDot:1
+13 ; TMPANS
SET TMPSCALE(DES)=TMPRSLT
End DoDot:1
+14 ; need to have a 2nd question before can do any calculations
+15 IF (DES=1)
SET RESPONSE=RESPONSE_DES_":"_ITEMSCOR(DES)_"|"
QUIT
+16 ; getting even numbered questions, satisfaction rating, needs conversion
+17 ; importance rating does not need any conversion.
+18 IF (DES#2)=0
Begin DoDot:1
+19 SET TMPSCALE(DES)=$SELECT(TMPSCALE(DES)=0:"-3",TMPSCALE(DES)=1:"-2",TMPSCALE(DES)=2:"-1",TMPSCALE(DES)=3:"1",TMPSCALE(DES)=4:"2",TMPSCALE(DES)=5:"3",1:TMPSCALE(DES))
+20 ; compute the scale, -99 = unendorsed
+21 IF (DES=26)
IF (TMPSCALE(DES-1)=0)
IF (TMPSCALE(DES)="-99")
Begin DoDot:2
+22 SET SCALE(DES/2)=0
End DoDot:2
+23 ; else if
+24 IF '$TEST
Begin DoDot:2
+25 IF (TMPSCALE(DES-1)="-99")!(TMPSCALE(DES)="-99")
Begin DoDot:3
+26 SET SCALE(DES/2)="-99"
End DoDot:3
+27 IF '$TEST
Begin DoDot:3
+28 SET SCALE(DES/2)=(TMPSCALE(DES-1)*TMPSCALE(DES))
End DoDot:3
End DoDot:2
+29 ; compute the raw score and determine if a valid importance item (odd # question)
+30 IF SCALE(DES/2)'="-99"
Begin DoDot:2
+31 SET RAWSCORE=RAWSCORE+(SCALE(DES/2))
+32 IF (TMPSCALE(DES-1)>0)
SET VALIDSCR=VALIDSCR+1
End DoDot:2
+33 ; used to compute invalid percentile score
+34 IF SCALE(DES/2)=0
SET WGHTSAT0=WGHTSAT0+1
+35 IF SCALE(DES/2)="-99"
SET WGHTSAT99=WGHTSAT99+1
End DoDot:1
+36 ;collect value of all individual questions with the value entered
+37 SET RESPONSE=RESPONSE_DES_":"_ITEMSCOR(DES)_"|"
+38 QUIT
+39 ;
SCORANS1 ;
+1 ; compute rawScore
+2 IF (VALIDSCR=0)
SET RAWSCORE="0.05"
+3 IF (VALIDSCR'=0)
SET RAWSCORE=$JUSTIFY(((RAWSCORE/VALIDSCR)+.05),0,1)
+4 SET RAW=$PIECE(RAWSCORE,".",1)_"."_$EXTRACT($PIECE(RAWSCORE,".",2),0,1)
+5 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)=YSINSNAM_" Scale not found"
End DoDot:1
QUIT
+5 ;
+6 KILL ^TMP($JOB,"YSCOR")
+7 SET ^TMP($JOB,"YSCOR",1)="[DATA]"
+8 SET ^TMP($JOB,"YSCOR",2)=$$GET1^DIQ(601.87,762_",",3,"I")_"="_SCALE("1")
+9 SET ^TMP($JOB,"YSCOR",3)=$$GET1^DIQ(601.87,763_",",3,"I")_"="_SCALE("2")
+10 SET ^TMP($JOB,"YSCOR",4)=$$GET1^DIQ(601.87,764_",",3,"I")_"="_SCALE("3")
+11 SET ^TMP($JOB,"YSCOR",5)=$$GET1^DIQ(601.87,765_",",3,"I")_"="_SCALE("4")
+12 SET ^TMP($JOB,"YSCOR",6)=$$GET1^DIQ(601.87,766_",",3,"I")_"="_SCALE("5")
+13 SET ^TMP($JOB,"YSCOR",7)=$$GET1^DIQ(601.87,767_",",3,"I")_"="_SCALE("6")
+14 SET ^TMP($JOB,"YSCOR",8)=$$GET1^DIQ(601.87,768_",",3,"I")_"="_SCALE("7")
+15 SET ^TMP($JOB,"YSCOR",9)=$$GET1^DIQ(601.87,769_",",3,"I")_"="_SCALE("8")
+16 SET ^TMP($JOB,"YSCOR",10)=$$GET1^DIQ(601.87,770_",",3,"I")_"="_SCALE("9")
+17 SET ^TMP($JOB,"YSCOR",11)=$$GET1^DIQ(601.87,771_",",3,"I")_"="_SCALE("10")
+18 SET ^TMP($JOB,"YSCOR",12)=$$GET1^DIQ(601.87,772_",",3,"I")_"="_SCALE("11")
+19 SET ^TMP($JOB,"YSCOR",13)=$$GET1^DIQ(601.87,773_",",3,"I")_"="_SCALE("12")
+20 SET ^TMP($JOB,"YSCOR",14)=$$GET1^DIQ(601.87,774_",",3,"I")_"="_SCALE("13")
+21 SET ^TMP($JOB,"YSCOR",15)=$$GET1^DIQ(601.87,775_",",3,"I")_"="_SCALE("14")
+22 SET ^TMP($JOB,"YSCOR",16)=$$GET1^DIQ(601.87,776_",",3,"I")_"="_SCALE("15")
+23 SET ^TMP($JOB,"YSCOR",17)=$$GET1^DIQ(601.87,777_",",3,"I")_"="_SCALE("16")
+24 QUIT
+25 ;
DLLSTR(YSDATA,YS,YSTRNG) ;
+1 ; YSTRNG = 1 Score Instrument
+2 ; YSTRNG = 2 get Report Answers and Text
+3 NEW DATA,DES,I,NODE,LEG,YSQN,YSCDA,INDENT,TMPANS
+4 NEW YSINSNAM,ITEMSCOR,SCALE,TMPSCALE
+5 NEW TMPRSLT,VALIDSCR
+6 NEW SCORESTR,TSCORBAR,TSCORE,OMITTED,FLAG
+7 NEW OMITITEM,RESPONSE,STRING,STRING1
+8 NEW PROTECT,USE,RISK,RESULT
+9 NEW RAW,WGHTSAT0,WGHTSAT99
+10 ;
+11 SET (TSCORE,SCORESTR,VALIDSCR)=0
+12 SET (OMITTED,TSCORBAR)=""
+13 ;
+14 FOR I=1:1:32
SET TMPSCALE(I)=0
+15 FOR I=1:1:32
SET ITEMSCOR(I)=""
+16 FOR I=1:1:16
SET SCALE(I)=0
SET SCALE(I_"."_5)=0
+17 ;
+18 SET (OMITITEM,RESPONSE,STRING,STRING1)=""
+19 SET (PROTECT,USE,RISK)=0
+20 SET (RAW,WGHTSAT0,WGHTSAT99)=0
+21 SET TMPRSLT=0
+22 ;
+23 DO DATA1
+24 ;
+25 IF YSTRNG=1
DO SCORESV
+26 ;
+27 IF YSTRNG=2
Begin DoDot:1
+28 DO LDSCORES^YTSCORE(.YSDATA,.YS)
+29 DO STRING
+30 SET YSDATA($ORDER(YSDATA(""),-1)+1)=999999999999_U_U_STRING
End DoDot:1
+31 QUIT
