- 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 Feb 18, 2025@23:47:03 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