- YTSWHYMP ;SLC/PIJ - Score WHYMPI ; 01/08/2016@1200
- ;;5.01;MENTAL HEALTH;**123**;DEC 30, 1994;Build 73
- ;
- ;Public, Supported ICRs
- ; #2056 - Fileman API - $$GET1^DIQ
- ;
- Q
- ;
- DATA1 ;
- 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 ; Start at YSDATA(3)
- .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 (LEG="N")!(LEG="Y") Q
- .I (YSCDA=1155)!(YSCDA=1156) D TALLYRAW Q
- .D SCORE
- Q
- ;
- TALLYRAW ;
- ; Part I. Interference
- I (DES="A2")!(DES="A3")!(DES="A4")!(DES="A8")!(DES="A9")!(DES="A13")!(DES="A14")!(DES="A17")!(DES="A19") D
- .S INTERFER=INTERFER+1
- ; Support
- I (DES="A5")!(DES="A10")!(DES="A15") D
- .S SUPPORT=SUPPORT+1
- ; Pain Severity
- I (DES="A1")!(DES="A7")!(DES="A12") D
- .S PAIN=PAIN+1
- ; Life-Control
- I (DES="A11")!(DES="A16") D
- .S LIFE=LIFE+1
- ; Affective Distress
- I (DES="A6")!(DES="A18")!(DES="A20") D
- .S AFFECT=AFFECT+1
- ; Part II.
- ; Negative Response
- I (DES="B1")!(DES="B4")!(DES="B7")!(DES="B10") D
- .S NEG=NEG+1
- ; Solicitous Response
- I (DES="B2")!(DES="B5")!(DES="B8")!(DES="B11")!(DES="B13")!(DES="B14") D
- .S SOLICIT=SOLICIT+1
- ; Distracting Response
- I (DES="B3")!(DES="B6")!(DES="B9")!(DES="B12") D
- .S DISTRACT=DISTRACT+1
- .; Part III.
- .; Household Chores
- I (DES="C1")!(DES="C5")!(DES="C9")!(DES="C13")!(DES="C17") D
- .S HOUSE=HOUSE+1
- ; Outdoor Work
- I (DES="C2")!(DES="C6")!(DES="C10")!(DES="C14")!(DES="C18") D
- .S OUTDOOR=OUTDOOR+1
- ; Activities away from home
- I (DES="C3")!(DES="C7")!(DES="C11")!(DES="C15") D
- .S ACTIVITY=ACTIVITY+1
- ; Social Activities
- I (DES="C4")!(DES="C8")!(DES="C12")!(DES="C16") D
- .S SOCIAL=SOCIAL+1
- Q
- ;
- SCORE ;
- ; Part I.
- ;Interference
- I (DES="A2")!(DES="A3")!(DES="A4")!(DES="A8")!(DES="A9")!(DES="A13")!(DES="A14")!(DES="A17")!(DES="A19") D
- .S TOTINT=TOTINT+$G(YSCDA,0)
- ; Support
- I (DES="A5")!(DES="A10")!(DES="A15") D
- .S TOTSUPP=TOTSUPP+$G(YSCDA,0)
- ; Pain Severity
- I (DES="A1")!(DES="A7")!(DES="A12") D
- .S TOTPAIN=TOTPAIN+$G(YSCDA,0)
- ; Life-Control
- I (DES="A11")!(DES="A16") D
- .S TOTLIFE=TOTLIFE+$G(YSCDA,0)
- ; Affective Distress
- I (DES="A6")!(DES="A18")!(DES="A20") D
- .I (DES="A6") S YSCDA=(6-$G(YSCDA,0)) ; This is the correction for Affective Disorder
- .S TOTAFF=TOTAFF+$G(YSCDA,0) ; per Dr. Garcia. The (6-YSCDA) is the reverse
- ; Part II.
- ; Negative Response
- I (DES="B1")!(DES="B4")!(DES="B7")!(DES="B10") D
- .S TOTNEG=TOTNEG+$G(YSCDA,0)
- ; Solicitous Response
- I (DES="B2")!(DES="B5")!(DES="B8")!(DES="B11")!(DES="B13")!(DES="B14") D
- .S TOTSOL=TOTSOL+$G(YSCDA,0)
- ; Distracting Response
- I (DES="B3")!(DES="B6")!(DES="B9")!(DES="B12") D
- .S TOTDIS=TOTDIS+$G(YSCDA,0)
- ; Part III.
- ; Household Chores
- I (DES="C1")!(DES="C5")!(DES="C9")!(DES="C13")!(DES="C17") D
- .S TOTHOUSE=TOTHOUSE+$G(YSCDA,0)
- ; Outdoor Work
- I (DES="C2")!(DES="C6")!(DES="C10")!(DES="C14")!(DES="C18") D
- .S TOTOUTDR=TOTOUTDR+$G(YSCDA,0)
- ; Activities away from home
- I (DES="C3")!(DES="C7")!(DES="C11")!(DES="C15") D
- .S TOTACTIVE=TOTACTIVE+$G(YSCDA,0)
- ; Social Activities
- I (DES="C4")!(DES="C8")!(DES="C12")!(DES="C16") D
- .S TOTSOC=TOTSOC+$G(YSCDA,0)
- Q
- ;
- TOTSCR ; Interference
- S INTERSC="Too many skipped questions"
- I (INTERFER<3) D
- .S INTERSC=$J(TOTINT/(9-INTERFER),0,2)
- ; Support
- S SUPSC="Too many skipped questions"
- I (SUPPORT<2) D
- .S SUPSC=$J(TOTSUPP/(3-SUPPORT),0,2)
- ; Pain Severity
- S PAINSC="Too many skipped questions"
- I (PAIN<2) D
- .S PAINSC=$J(TOTPAIN/(3-PAIN),0,2)
- ; Life-Control
- S LIFESC="Too many skipped questions"
- I (LIFE<2) D
- .S LIFESC=$J(TOTLIFE/(2-LIFE),0,2)
- ; Affective Distress
- S AFFECTSC="Too many skipped questions"
- I (AFFECT<2) D
- .S AFFECTSC=$J(TOTAFF/(3-AFFECT),0,2)
- ; Part II.
- ; Negative Responses
- S NEGSC="Too many skipped questions"
- I (NEG<2) D
- .S NEGSC=$J(TOTNEG/(4-NEG),0,2)
- ; Solicitous Responses
- S SOLSC="Too many skipped questions"
- I (SOLICIT<2) D
- .S SOLSC=$J(TOTSOL/(6-SOLICIT),0,2)
- ; Distracting Responses
- S DISSC="Too many skipped questions"
- I (DISTRACT<2) D
- .S DISSC=$J(TOTDIS/(4-DISTRACT),0,2)
- ; Part III.
- ; Household Chores
- S HOUSC="Too many skipped questions"
- I (HOUSE<2) D
- .S HOUSC=$J(TOTHOUSE/(5-HOUSE),0,2)
- ; Outdoor Work
- S OUTSC="Too many skipped questions"
- I (OUTDOOR<2) D
- .S OUTSC=$J(TOTOUTDR/(5-OUTDOOR),0,2)
- ; Activities Away from Home
- S ACTSC="Too many skipped questions"
- I (ACTIVITY<2) D
- .S ACTSC=$J(TOTACTIVE/(4-ACTIVITY),0,2)
- ; Social Activities
- S SOCSC="Too many skipped questions"
- I (SOCIAL<2) D
- .S SOCSC=$J(TOTSOC/(4-SOCIAL),0,2)
- ; General Activity - total skipped questions
- S GENERAL=HOUSE+OUTDOOR+ACTIVITY+SOCIAL
- S GENSC="Too many skipped questions"
- I (GENERAL<5) D
- .S GENSC=$J((TOTHOUSE+TOTOUTDR+TOTACTIVE+TOTSOC)/(18-GENERAL),0,2)
- 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)="WHYMPI Scale not found"
- ;
- K ^TMP($J,"YSCOR")
- S ^TMP($J,"YSCOR",1)="[DATA]"
- ;Part I
- S ^TMP($J,"YSCOR",2)=$$GET1^DIQ(601.87,507_",",3,"I")_"="_INTERSC
- S ^TMP($J,"YSCOR",3)=$$GET1^DIQ(601.87,508_",",3,"I")_"="_SUPSC
- S ^TMP($J,"YSCOR",4)=$$GET1^DIQ(601.87,553_",",3,"I")_"="_PAINSC
- S ^TMP($J,"YSCOR",5)=$$GET1^DIQ(601.87,554_",",3,"I")_"="_LIFESC
- S ^TMP($J,"YSCOR",6)=$$GET1^DIQ(601.87,555_",",3,"I")_"="_AFFECTSC
- ;Part II
- S ^TMP($J,"YSCOR",7)=$$GET1^DIQ(601.87,556_",",3,"I")_"="_NEGSC
- S ^TMP($J,"YSCOR",8)=$$GET1^DIQ(601.87,557_",",3,"I")_"="_SOLSC
- S ^TMP($J,"YSCOR",9)=$$GET1^DIQ(601.87,558_",",3,"I")_"="_DISSC
- ;Part III.
- S ^TMP($J,"YSCOR",10)=$$GET1^DIQ(601.87,559_",",3,"I")_"="_HOUSC
- S ^TMP($J,"YSCOR",11)=$$GET1^DIQ(601.87,560_",",3,"I")_"="_OUTSC
- S ^TMP($J,"YSCOR",12)=$$GET1^DIQ(601.87,561_",",3,"I")_"="_ACTSC
- S ^TMP($J,"YSCOR",13)=$$GET1^DIQ(601.87,562_",",3,"I")_"="_SOCSC
- S ^TMP($J,"YSCOR",14)=$$GET1^DIQ(601.87,563_",",3,"I")_"="_GENSC
- Q
- ;
- DLLSTR(YSDATA,YS,YSTRNG) ;
- ; YSTRNG = 1 Score Instrument
- ; YSTRNG = 2 get Report Answers and Text
- N DATA,DES,NODE,LEG,YSCDA,YSQN,YSINSNAM
- N ACTIVITY,AFFECT,DISTRACT,GENERAL,HOUSE,INTERFER,LIFE,NEG,OUTDOOR,PAIN
- N SOCIAL,SOLICIT,SUPPORT,TOTACTIVE,TOTAFF,TOTDIS,TOTHOUSE
- N TOTINT,TOTLIFE,TOTNEG,TOTOUTDR,TOTPAIN,TOTSOC,TOTSOL,TOTSUPP
- N INTERSC,SUPSC,PAINSC,LIFESC,AFFECTSC,NEGSC,SOLSC,DISSC,HOUSC,OUTSC,ACTSC,SOCSC,GENSC
- ;
- S (ACTIVITY,AFFECT,DISTRACT,HOUSE,INTERFER,LIFE,NEG,OUTDOOR,PAIN)=0
- S (SOCIAL,SOLICIT,SUPPORT,TOTACTIVE,TOTAFF,TOTDIS,TOTHOUSE)=0
- S (TOTINT,TOTLIFE,TOTNEG,TOTOUTDR,TOTPAIN,TOTSOC,TOTSOL,TOTSUPP)=0
- ;
- I YSTRNG=2 Q ; no special text in the report
- ;
- D DATA1
- D TOTSCR
- D SCORESV
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTSWHYMP 6874 printed Feb 18, 2025@23:48:13 Page 2
- YTSWHYMP ;SLC/PIJ - Score WHYMPI ; 01/08/2016@1200
- +1 ;;5.01;MENTAL HEALTH;**123**;DEC 30, 1994;Build 73
- +2 ;
- +3 ;Public, Supported ICRs
- +4 ; #2056 - Fileman API - $$GET1^DIQ
- +5 ;
- +6 QUIT
- +7 ;
- DATA1 ;
- +1 SET YSINSNAM=$PIECE($GET(YSDATA(2)),U,3)
- +2 IF $GET(YSINSNAM)=""
- SET YSINSNAM=$GET(YS("CODE"),"NO NAME PASSED")
- +3 ; Start at YSDATA(3)
- SET NODE=2
- FOR
- SET NODE=$ORDER(YSDATA(NODE))
- if NODE=""
- QUIT
- Begin DoDot:1
- +4 SET DATA=YSDATA(NODE)
- +5 SET YSQN=$PIECE(DATA,U,1)
- +6 SET YSCDA=$PIECE($GET(DATA),U,3)
- +7 DO DESGNTR^YTSCORE(YSQN,.DES)
- +8 SET LEG=$$GET1^DIQ(601.75,YSCDA_",",4,"I")
- +9 IF (LEG="N")!(LEG="Y")
- QUIT
- +10 IF (YSCDA=1155)!(YSCDA=1156)
- DO TALLYRAW
- QUIT
- +11 DO SCORE
- End DoDot:1
- +12 QUIT
- +13 ;
- TALLYRAW ;
- +1 ; Part I. Interference
- +2 IF (DES="A2")!(DES="A3")!(DES="A4")!(DES="A8")!(DES="A9")!(DES="A13")!(DES="A14")!(DES="A17")!(DES="A19")
- Begin DoDot:1
- +3 SET INTERFER=INTERFER+1
- End DoDot:1
- +4 ; Support
- +5 IF (DES="A5")!(DES="A10")!(DES="A15")
- Begin DoDot:1
- +6 SET SUPPORT=SUPPORT+1
- End DoDot:1
- +7 ; Pain Severity
- +8 IF (DES="A1")!(DES="A7")!(DES="A12")
- Begin DoDot:1
- +9 SET PAIN=PAIN+1
- End DoDot:1
- +10 ; Life-Control
- +11 IF (DES="A11")!(DES="A16")
- Begin DoDot:1
- +12 SET LIFE=LIFE+1
- End DoDot:1
- +13 ; Affective Distress
- +14 IF (DES="A6")!(DES="A18")!(DES="A20")
- Begin DoDot:1
- +15 SET AFFECT=AFFECT+1
- End DoDot:1
- +16 ; Part II.
- +17 ; Negative Response
- +18 IF (DES="B1")!(DES="B4")!(DES="B7")!(DES="B10")
- Begin DoDot:1
- +19 SET NEG=NEG+1
- End DoDot:1
- +20 ; Solicitous Response
- +21 IF (DES="B2")!(DES="B5")!(DES="B8")!(DES="B11")!(DES="B13")!(DES="B14")
- Begin DoDot:1
- +22 SET SOLICIT=SOLICIT+1
- End DoDot:1
- +23 ; Distracting Response
- +24 IF (DES="B3")!(DES="B6")!(DES="B9")!(DES="B12")
- Begin DoDot:1
- +25 SET DISTRACT=DISTRACT+1
- +26 ; Part III.
- +27 ; Household Chores
- End DoDot:1
- +28 IF (DES="C1")!(DES="C5")!(DES="C9")!(DES="C13")!(DES="C17")
- Begin DoDot:1
- +29 SET HOUSE=HOUSE+1
- End DoDot:1
- +30 ; Outdoor Work
- +31 IF (DES="C2")!(DES="C6")!(DES="C10")!(DES="C14")!(DES="C18")
- Begin DoDot:1
- +32 SET OUTDOOR=OUTDOOR+1
- End DoDot:1
- +33 ; Activities away from home
- +34 IF (DES="C3")!(DES="C7")!(DES="C11")!(DES="C15")
- Begin DoDot:1
- +35 SET ACTIVITY=ACTIVITY+1
- End DoDot:1
- +36 ; Social Activities
- +37 IF (DES="C4")!(DES="C8")!(DES="C12")!(DES="C16")
- Begin DoDot:1
- +38 SET SOCIAL=SOCIAL+1
- End DoDot:1
- +39 QUIT
- +40 ;
- SCORE ;
- +1 ; Part I.
- +2 ;Interference
- +3 IF (DES="A2")!(DES="A3")!(DES="A4")!(DES="A8")!(DES="A9")!(DES="A13")!(DES="A14")!(DES="A17")!(DES="A19")
- Begin DoDot:1
- +4 SET TOTINT=TOTINT+$GET(YSCDA,0)
- End DoDot:1
- +5 ; Support
- +6 IF (DES="A5")!(DES="A10")!(DES="A15")
- Begin DoDot:1
- +7 SET TOTSUPP=TOTSUPP+$GET(YSCDA,0)
- End DoDot:1
- +8 ; Pain Severity
- +9 IF (DES="A1")!(DES="A7")!(DES="A12")
- Begin DoDot:1
- +10 SET TOTPAIN=TOTPAIN+$GET(YSCDA,0)
- End DoDot:1
- +11 ; Life-Control
- +12 IF (DES="A11")!(DES="A16")
- Begin DoDot:1
- +13 SET TOTLIFE=TOTLIFE+$GET(YSCDA,0)
- End DoDot:1
- +14 ; Affective Distress
- +15 IF (DES="A6")!(DES="A18")!(DES="A20")
- Begin DoDot:1
- +16 ; This is the correction for Affective Disorder
- IF (DES="A6")
- SET YSCDA=(6-$GET(YSCDA,0))
- +17 ; per Dr. Garcia. The (6-YSCDA) is the reverse
- SET TOTAFF=TOTAFF+$GET(YSCDA,0)
- End DoDot:1
- +18 ; Part II.
- +19 ; Negative Response
- +20 IF (DES="B1")!(DES="B4")!(DES="B7")!(DES="B10")
- Begin DoDot:1
- +21 SET TOTNEG=TOTNEG+$GET(YSCDA,0)
- End DoDot:1
- +22 ; Solicitous Response
- +23 IF (DES="B2")!(DES="B5")!(DES="B8")!(DES="B11")!(DES="B13")!(DES="B14")
- Begin DoDot:1
- +24 SET TOTSOL=TOTSOL+$GET(YSCDA,0)
- End DoDot:1
- +25 ; Distracting Response
- +26 IF (DES="B3")!(DES="B6")!(DES="B9")!(DES="B12")
- Begin DoDot:1
- +27 SET TOTDIS=TOTDIS+$GET(YSCDA,0)
- End DoDot:1
- +28 ; Part III.
- +29 ; Household Chores
- +30 IF (DES="C1")!(DES="C5")!(DES="C9")!(DES="C13")!(DES="C17")
- Begin DoDot:1
- +31 SET TOTHOUSE=TOTHOUSE+$GET(YSCDA,0)
- End DoDot:1
- +32 ; Outdoor Work
- +33 IF (DES="C2")!(DES="C6")!(DES="C10")!(DES="C14")!(DES="C18")
- Begin DoDot:1
- +34 SET TOTOUTDR=TOTOUTDR+$GET(YSCDA,0)
- End DoDot:1
- +35 ; Activities away from home
- +36 IF (DES="C3")!(DES="C7")!(DES="C11")!(DES="C15")
- Begin DoDot:1
- +37 SET TOTACTIVE=TOTACTIVE+$GET(YSCDA,0)
- End DoDot:1
- +38 ; Social Activities
- +39 IF (DES="C4")!(DES="C8")!(DES="C12")!(DES="C16")
- Begin DoDot:1
- +40 SET TOTSOC=TOTSOC+$GET(YSCDA,0)
- End DoDot:1
- +41 QUIT
- +42 ;
- TOTSCR ; Interference
- +1 SET INTERSC="Too many skipped questions"
- +2 IF (INTERFER<3)
- Begin DoDot:1
- +3 SET INTERSC=$JUSTIFY(TOTINT/(9-INTERFER),0,2)
- End DoDot:1
- +4 ; Support
- +5 SET SUPSC="Too many skipped questions"
- +6 IF (SUPPORT<2)
- Begin DoDot:1
- +7 SET SUPSC=$JUSTIFY(TOTSUPP/(3-SUPPORT),0,2)
- End DoDot:1
- +8 ; Pain Severity
- +9 SET PAINSC="Too many skipped questions"
- +10 IF (PAIN<2)
- Begin DoDot:1
- +11 SET PAINSC=$JUSTIFY(TOTPAIN/(3-PAIN),0,2)
- End DoDot:1
- +12 ; Life-Control
- +13 SET LIFESC="Too many skipped questions"
- +14 IF (LIFE<2)
- Begin DoDot:1
- +15 SET LIFESC=$JUSTIFY(TOTLIFE/(2-LIFE),0,2)
- End DoDot:1
- +16 ; Affective Distress
- +17 SET AFFECTSC="Too many skipped questions"
- +18 IF (AFFECT<2)
- Begin DoDot:1
- +19 SET AFFECTSC=$JUSTIFY(TOTAFF/(3-AFFECT),0,2)
- End DoDot:1
- +20 ; Part II.
- +21 ; Negative Responses
- +22 SET NEGSC="Too many skipped questions"
- +23 IF (NEG<2)
- Begin DoDot:1
- +24 SET NEGSC=$JUSTIFY(TOTNEG/(4-NEG),0,2)
- End DoDot:1
- +25 ; Solicitous Responses
- +26 SET SOLSC="Too many skipped questions"
- +27 IF (SOLICIT<2)
- Begin DoDot:1
- +28 SET SOLSC=$JUSTIFY(TOTSOL/(6-SOLICIT),0,2)
- End DoDot:1
- +29 ; Distracting Responses
- +30 SET DISSC="Too many skipped questions"
- +31 IF (DISTRACT<2)
- Begin DoDot:1
- +32 SET DISSC=$JUSTIFY(TOTDIS/(4-DISTRACT),0,2)
- End DoDot:1
- +33 ; Part III.
- +34 ; Household Chores
- +35 SET HOUSC="Too many skipped questions"
- +36 IF (HOUSE<2)
- Begin DoDot:1
- +37 SET HOUSC=$JUSTIFY(TOTHOUSE/(5-HOUSE),0,2)
- End DoDot:1
- +38 ; Outdoor Work
- +39 SET OUTSC="Too many skipped questions"
- +40 IF (OUTDOOR<2)
- Begin DoDot:1
- +41 SET OUTSC=$JUSTIFY(TOTOUTDR/(5-OUTDOOR),0,2)
- End DoDot:1
- +42 ; Activities Away from Home
- +43 SET ACTSC="Too many skipped questions"
- +44 IF (ACTIVITY<2)
- Begin DoDot:1
- +45 SET ACTSC=$JUSTIFY(TOTACTIVE/(4-ACTIVITY),0,2)
- End DoDot:1
- +46 ; Social Activities
- +47 SET SOCSC="Too many skipped questions"
- +48 IF (SOCIAL<2)
- Begin DoDot:1
- +49 SET SOCSC=$JUSTIFY(TOTSOC/(4-SOCIAL),0,2)
- End DoDot:1
- +50 ; General Activity - total skipped questions
- +51 SET GENERAL=HOUSE+OUTDOOR+ACTIVITY+SOCIAL
- +52 SET GENSC="Too many skipped questions"
- +53 IF (GENERAL<5)
- Begin DoDot:1
- +54 SET GENSC=$JUSTIFY((TOTHOUSE+TOTOUTDR+TOTACTIVE+TOTSOC)/(18-GENERAL),0,2)
- End DoDot:1
- +55 QUIT
- +56 ;
- 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)="WHYMPI Scale not found"
- End DoDot:1
- QUIT
- +5 ;
- +6 KILL ^TMP($JOB,"YSCOR")
- +7 SET ^TMP($JOB,"YSCOR",1)="[DATA]"
- +8 ;Part I
- +9 SET ^TMP($JOB,"YSCOR",2)=$$GET1^DIQ(601.87,507_",",3,"I")_"="_INTERSC
- +10 SET ^TMP($JOB,"YSCOR",3)=$$GET1^DIQ(601.87,508_",",3,"I")_"="_SUPSC
- +11 SET ^TMP($JOB,"YSCOR",4)=$$GET1^DIQ(601.87,553_",",3,"I")_"="_PAINSC
- +12 SET ^TMP($JOB,"YSCOR",5)=$$GET1^DIQ(601.87,554_",",3,"I")_"="_LIFESC
- +13 SET ^TMP($JOB,"YSCOR",6)=$$GET1^DIQ(601.87,555_",",3,"I")_"="_AFFECTSC
- +14 ;Part II
- +15 SET ^TMP($JOB,"YSCOR",7)=$$GET1^DIQ(601.87,556_",",3,"I")_"="_NEGSC
- +16 SET ^TMP($JOB,"YSCOR",8)=$$GET1^DIQ(601.87,557_",",3,"I")_"="_SOLSC
- +17 SET ^TMP($JOB,"YSCOR",9)=$$GET1^DIQ(601.87,558_",",3,"I")_"="_DISSC
- +18 ;Part III.
- +19 SET ^TMP($JOB,"YSCOR",10)=$$GET1^DIQ(601.87,559_",",3,"I")_"="_HOUSC
- +20 SET ^TMP($JOB,"YSCOR",11)=$$GET1^DIQ(601.87,560_",",3,"I")_"="_OUTSC
- +21 SET ^TMP($JOB,"YSCOR",12)=$$GET1^DIQ(601.87,561_",",3,"I")_"="_ACTSC
- +22 SET ^TMP($JOB,"YSCOR",13)=$$GET1^DIQ(601.87,562_",",3,"I")_"="_SOCSC
- +23 SET ^TMP($JOB,"YSCOR",14)=$$GET1^DIQ(601.87,563_",",3,"I")_"="_GENSC
- +24 QUIT
- +25 ;
- DLLSTR(YSDATA,YS,YSTRNG) ;
- +1 ; YSTRNG = 1 Score Instrument
- +2 ; YSTRNG = 2 get Report Answers and Text
- +3 NEW DATA,DES,NODE,LEG,YSCDA,YSQN,YSINSNAM
- +4 NEW ACTIVITY,AFFECT,DISTRACT,GENERAL,HOUSE,INTERFER,LIFE,NEG,OUTDOOR,PAIN
- +5 NEW SOCIAL,SOLICIT,SUPPORT,TOTACTIVE,TOTAFF,TOTDIS,TOTHOUSE
- +6 NEW TOTINT,TOTLIFE,TOTNEG,TOTOUTDR,TOTPAIN,TOTSOC,TOTSOL,TOTSUPP
- +7 NEW INTERSC,SUPSC,PAINSC,LIFESC,AFFECTSC,NEGSC,SOLSC,DISSC,HOUSC,OUTSC,ACTSC,SOCSC,GENSC
- +8 ;
- +9 SET (ACTIVITY,AFFECT,DISTRACT,HOUSE,INTERFER,LIFE,NEG,OUTDOOR,PAIN)=0
- +10 SET (SOCIAL,SOLICIT,SUPPORT,TOTACTIVE,TOTAFF,TOTDIS,TOTHOUSE)=0
- +11 SET (TOTINT,TOTLIFE,TOTNEG,TOTOUTDR,TOTPAIN,TOTSOC,TOTSOL,TOTSUPP)=0
- +12 ;
- +13 ; no special text in the report
- IF YSTRNG=2
- QUIT
- +14 ;
- +15 DO DATA1
- +16 DO TOTSCR
- +17 DO SCORESV
- +18 QUIT