YTSBAS24 ;SLC/PIJ - Score BASIS-24 ; 01/08/2016
;;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 YSSEQ=$P(DATA,U,2),YSSEQ=$P(YSSEQ,";",1)
.S YSCDA=$P($G(DATA),U,3) ; Choice ID
.D DESGNTR^YTSCORE(YSQN,.DES)
.I YSCDA=1155 S LEG="X" ; SKIPPED
.I (YSCDA=803) S LEG=0 ; No difficulty
.I (YSCDA=2853) S LEG=1 ; A little difficult
.I (YSCDA=805) S LEG=2 ; Moderate difficulty
.I (YSCDA=806) S LEG=3 ; Quite a bit of difficulty
.I (YSCDA=807) S LEG=4 ; Extreme difficulty
.;
.I (YSCDA=814) S LEG=0 ; None of the time
.I (YSCDA=815) S LEG=1 ; A little of the time
.I (YSCDA=884) S LEG=2 ; Half of the time
.I (YSCDA=772) S LEG=3 ; Most of the time
.I (YSCDA=817) S LEG=4 ; All of the time
.;
.I (YSCDA=217) S LEG=0 ; Never
.I (YSCDA=242) S LEG=1 ; Rarely
.I (YSCDA=213) S LEG=2 ; Sometimes
.I (YSCDA=215) S LEG=3 ; Often
.I (YSCDA=995) S LEG=4 ; Always
.I LEG="X" D SKIPQUES Q
.D TALLYSUM
D TOTCAL
Q
;
SKIPQUES ;
; Depression
I (DES=1) S DEPWT="0.186",TOTALWT="0.0696",DEP=DEP+1 Q
I (DES=2) S DEPWT="0.2612",TOTALWT="0.1061",DEP=DEP+1 Q
I (DES=3) S DEPWT="0.1763",TOTALWT="0.07",DEP=DEP+1 Q
I (DES=9) S DEPWT="0.0882",TOTALWT="0.0565",DEP=DEP+1 Q
I (DES=10) S DEPWT="0.1679",TOTALWT="0.0942",DEP=DEP+1 Q
I (DES=12) S DEPWT="0.1204",TOTALWT="0.0586",DEP=DEP+1 Q
; Interpersonal Problems
I (DES=4) S INTERWT="0.1583",TOTALWT="0.0251",INTER=INTER+1 Q
I (DES=5) S INTERWT="0.3299",TOTALWT="0.0279",INTER=INTER+1 Q
I (DES=6) S INTERWT="0.2754",TOTALWT="0.0297",INTER=INTER+1 Q
I (DES=7) S INTERWT="0.1362",TOTALWT="0.027",INTER=INTER+1 Q
I (DES=8) S INTERWT="0.1002",TOTALWT="0.0241",INTER=INTER+1 Q
; Psycholtic Symptoms
I (DES=14) S PSYWT="0.1049",TOTALWT="0.0164",PSY=PSY+1 Q
I (DES=15) S PSYWT="0.136",TOTALWT="0.023",PSY=PSY+1 Q
I (DES=16) S PSYWT="0.4636",TOTALWT="0.0243",PSY=PSY+1 Q
I (DES=17) S PSYWT="0.2955",TOTALWT="0.0304",PSY=PSY+1 Q
; Alcohol/Drug Use
I (DES=21) S ALCWT="0.34",TOTALWT="0.0178",ALC=ALC+1 Q
I (DES=22) S ALCWT="0.234",TOTALWT="0.0135",ALC=ALC+1 Q
I (DES=23) S ALCWT="0.1556",TOTALWT="0.01",ALC=ALC+1 Q
I (DES=24) S ALCWT="0.2704",TOTALWT="0.0128",ALC=ALC+1 Q
; Emotional Liability
I (DES=13) S EMOWT="11.02",TOTALWT="0.0384",EMO=EMO+1 Q
I (DES=18) S EMOWT="61.32",TOTALWT="0.065",EMO=EMO+1 Q
I (DES=19) S EMOWT="27.66",TOTALWT="0.0589",EMO=EMO+1 Q
; Self-Harm
I (DES=11) S HARMWT="0.4175",TOTALWT="0.0483",HARM=HARM+1 Q
I (DES=20) S HARMWT="0.5825",TOTALWT="0.0524",HARM=HARM+1 Q
Q
;
TALLYSUM ;
; Depression
I (DES=1) S DEPSUM=DEPSUM+(LEG*"0.1860"),TOTALSUM=TOTALSUM+(LEG*"0.0696") Q
I (DES=2) S DEPSUM=DEPSUM+(LEG*"0.2612"),TOTALSUM=TOTALSUM+(LEG*"0.1061") Q
I (DES=3) S DEPSUM=DEPSUM+(LEG*"0.1763"),TOTALSUM=TOTALSUM+(LEG*"0.07") Q
; Reverse this item
I (DES=9) S DEPSUM=DEPSUM+((4-LEG)*"0.0882"),TOTALSUM=TOTALSUM+((4-LEG)*"0.0565") Q
I (DES=10) S DEPSUM=DEPSUM+(LEG*"0.1679"),TOTALSUM=TOTALSUM+(LEG*"0.0942") Q
I (DES=12) S DEPSUM=DEPSUM+(LEG*"0.1204"),TOTALSUM=TOTALSUM+(LEG*"0.0586") Q
; Interpersonal Problems: All reversed in scoring
I (DES=4) S INTERSUM=INTERSUM+((4-LEG)*"0.1583"),TOTALSUM=TOTALSUM+((4-LEG)*"0.0251") Q
I (DES=5) S INTERSUM=INTERSUM+((4-LEG)*"0.3299"),TOTALSUM=TOTALSUM+((4-LEG)*"0.0279") Q
I (DES=6) S INTERSUM=INTERSUM+((4-LEG)*"0.2754"),TOTALSUM=TOTALSUM+((4-LEG)*"0.0297") Q
I (DES=7) S INTERSUM=INTERSUM+((4-LEG)*"0.1362"),TOTALSUM=TOTALSUM+((4-LEG)*"0.027") Q
I (DES=8) S INTERSUM=INTERSUM+((4-LEG)*"0.1002"),TOTALSUM=TOTALSUM+((4-LEG)*"0.0241") Q
; Psycholtic Symptoms
I (DES=14) S PSYSUM=PSYSUM+(LEG*"0.1049"),TOTALSUM=TOTALSUM+(LEG*"0.0164") Q
I (DES=15) S PSYSUM=PSYSUM+(LEG*"0.136"),TOTALSUM=TOTALSUM+(LEG*"0.023") Q
I (DES=16) S PSYSUM=PSYSUM+(LEG*"0.4636"),TOTALSUM=TOTALSUM+(LEG*"0.0243") Q
I (DES=17) S PSYSUM=PSYSUM+(LEG*"0.2955"),TOTALSUM=TOTALSUM+(LEG*"0.0304") Q
; Alcohol/Drug Use
I (DES=21) S ALCSUM=ALCSUM+(LEG*"0.34"),TOTALSUM=TOTALSUM+(LEG*"0.0178") Q
I (DES=22) S ALCSUM=ALCSUM+(LEG*"0.234"),TOTALSUM=TOTALSUM+(LEG*"0.0135") Q
I (DES=23) S ALCSUM=ALCSUM+(LEG*"0.1556"),TOTALSUM=TOTALSUM+(LEG*"0.01") Q
I (DES=24) S ALCSUM=ALCSUM+(LEG*"0.2704"),TOTALSUM=TOTALSUM+(LEG*"0.0128") Q
; Emotional Liability
I (DES=13) S EMOSUM=EMOSUM+(LEG*"0.1102"),TOTALSUM=TOTALSUM+(LEG*"0.0384") Q
I (DES=18) S EMOSUM=EMOSUM+(LEG*"0.6132"),TOTALSUM=TOTALSUM+(LEG*"0.065") Q
I (DES=19) S EMOSUM=EMOSUM+(LEG*"0.2766"),TOTALSUM=TOTALSUM+(LEG*"0.0589") Q
; Self Harm
I (DES=11) S HARMSUM=HARMSUM+(LEG*"0.4175"),TOTALSUM=TOTALSUM+(LEG*"0.0483") Q
I (DES=20) S HARMSUM=HARMSUM+(LEG*"0.5825"),TOTALSUM=TOTALSUM+(LEG*"0.0524") Q
Q
;
TOTCAL ;
I (DEP=0) S DEPSUM=$J(DEPSUM,0,2)
I (DEP=1) S DEPSUM=$J((DEPSUM/(1-DEPWT)),0,2)
I (DEP>1) S DEPSUM="Too many skipped questions"
;
I (INTER=0) S INTERSUM=$J(INTERSUM,0,2)
I (INTER=1) S INTERSUM=$J((INTERSUM/(1-INTERWT)),0,2)
I (INTER>1) S INTERSUM="Too many skipped questions"
;
I (PSY=0) S PSYSUM=$J(PSYSUM,0,2)
I (PSY=1) S PSYSUM=$J(PSYSUM/(1-PSYWT),0,2)
I (PSY>1) S PSYSUM="Too many skipped questions"
;
I (ALC=0) S ALCSUM=$J(ALCSUM,0,2)
I (ALC=1) S ALCSUM=$J((ALCSUM/(1-ALCWT)),0,2)
I (ALC>1) S ALCSUM="Too many skipped questions"
;
I (EMO=0) S EMOSUM=$J(EMOSUM,0,2)
I (EMO=1) S EMOSUM=$J((EMOSUM/(1-EMOWT)),0,2)
I (EMO>1) S EMOSUM="Too many skipped questions"
;
I (HARM=0) S HARMSUM=$J(HARMSUM,0,2)
I (HARM=1) S HARMSUM=$J((HARMSUM/(1-HARMWT)),0,2)
I (HARM>1) S HARMSUM="Too many skipped questions"
;
I (DEP+INTER+PSY+ALC+EMO+HARM)=0 S TOTALSUM=$J(TOTALSUM,0,2)
I (DEP+INTER+PSY+ALC+EMO+HARM)=1 S TOTALSUM=$J((TOTALSUM/(1-TOTALWT)),0,2)
I (DEP+INTER+PSY+ALC+EMO+HARM)>1 S TOTALSUM="Too many skipped questions"
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"
;
S YSSCNAM=$P($G(^TMP($J,"YSG",3)),U,4) ; Scale Name
K ^TMP($J,"YSCOR")
S ^TMP($J,"YSCOR",1)="[DATA]"
S ^TMP($J,"YSCOR",2)=$$GET1^DIQ(601.87,596_",",3,"I")_"="_$J(DEPSUM,0,2)
S ^TMP($J,"YSCOR",3)=$$GET1^DIQ(601.87,597_",",3,"I")_"="_$J(INTERSUM,0,2)
S ^TMP($J,"YSCOR",4)=$$GET1^DIQ(601.87,598_",",3,"I")_"="_$J(PSYSUM,0,2)
S ^TMP($J,"YSCOR",5)=$$GET1^DIQ(601.87,599_",",3,"I")_"="_$J(ALCSUM,0,2)
S ^TMP($J,"YSCOR",6)=$$GET1^DIQ(601.87,600_",",3,"I")_"="_$J(EMOSUM,0,2)
S ^TMP($J,"YSCOR",7)=$$GET1^DIQ(601.87,601_",",3,"I")_"="_$J(HARMSUM,0,2)
S ^TMP($J,"YSCOR",8)=$$GET1^DIQ(601.87,602_",",3,"I")_"="_$J(TOTALSUM,0,2)
Q
;
DLLSTR(YSDATA,YS,YSTRNG) ;
; YSTRNG = 1 Score Instrument
; YSTRNG = 2 get Report Answers and Text)
N DATA,DES,LEG,NODE,YSQN
N YSCDA,YSSCNAM,YSINSNAM,YSSEQ,STRING
N ALCWT,DEPWT,EMOWT,HARMWT,INTERWT,PSYWT,TOTALWT
N DEP,INTER,PSY,ALC,EMO,HARM,TOTAL
N DEPSUM,INTERSUM,PSYSUM,ALCSUM,EMOSUM,HARMSUM,TOTALSUM
N DEPSC,INTERSC,PSYSC,ALCSC,EMOSC,HARMSC,TOTALSC,RESULT
;
S (ALCWT,DEPWT,EMOWT,HARMWT,INTERWT,PSYWT,TOTALWT)=0
S (DEP,INTER,PSY,ALC,EMO,HARM,TOTAL)=0
S (DEPSUM,INTERSUM,PSYSUM,ALCSUM,EMOSUM,HARMSUM,TOTALSUM)=0
S (DEPSC,INTERSC,PSYSC,ALCSC,EMOSC,HARMSC,TOTALSC,RESULT)=0
;
S STRING=""
;
;BASIS-24 returns scale scores which are calculated and stored, all special text in MH REPORT File
I YSTRNG=2 Q
;
D DATA1
D SCORESV
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTSBAS24 7670 printed Sep 11, 2024@02:39:15 Page 2
YTSBAS24 ;SLC/PIJ - Score BASIS-24 ; 01/08/2016
+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 YSSEQ=$PIECE(DATA,U,2)
SET YSSEQ=$PIECE(YSSEQ,";",1)
+7 ; Choice ID
SET YSCDA=$PIECE($GET(DATA),U,3)
+8 DO DESGNTR^YTSCORE(YSQN,.DES)
+9 ; SKIPPED
IF YSCDA=1155
SET LEG="X"
+10 ; No difficulty
IF (YSCDA=803)
SET LEG=0
+11 ; A little difficult
IF (YSCDA=2853)
SET LEG=1
+12 ; Moderate difficulty
IF (YSCDA=805)
SET LEG=2
+13 ; Quite a bit of difficulty
IF (YSCDA=806)
SET LEG=3
+14 ; Extreme difficulty
IF (YSCDA=807)
SET LEG=4
+15 ;
+16 ; None of the time
IF (YSCDA=814)
SET LEG=0
+17 ; A little of the time
IF (YSCDA=815)
SET LEG=1
+18 ; Half of the time
IF (YSCDA=884)
SET LEG=2
+19 ; Most of the time
IF (YSCDA=772)
SET LEG=3
+20 ; All of the time
IF (YSCDA=817)
SET LEG=4
+21 ;
+22 ; Never
IF (YSCDA=217)
SET LEG=0
+23 ; Rarely
IF (YSCDA=242)
SET LEG=1
+24 ; Sometimes
IF (YSCDA=213)
SET LEG=2
+25 ; Often
IF (YSCDA=215)
SET LEG=3
+26 ; Always
IF (YSCDA=995)
SET LEG=4
+27 IF LEG="X"
DO SKIPQUES
QUIT
+28 DO TALLYSUM
End DoDot:1
+29 DO TOTCAL
+30 QUIT
+31 ;
SKIPQUES ;
+1 ; Depression
+2 IF (DES=1)
SET DEPWT="0.186"
SET TOTALWT="0.0696"
SET DEP=DEP+1
QUIT
+3 IF (DES=2)
SET DEPWT="0.2612"
SET TOTALWT="0.1061"
SET DEP=DEP+1
QUIT
+4 IF (DES=3)
SET DEPWT="0.1763"
SET TOTALWT="0.07"
SET DEP=DEP+1
QUIT
+5 IF (DES=9)
SET DEPWT="0.0882"
SET TOTALWT="0.0565"
SET DEP=DEP+1
QUIT
+6 IF (DES=10)
SET DEPWT="0.1679"
SET TOTALWT="0.0942"
SET DEP=DEP+1
QUIT
+7 IF (DES=12)
SET DEPWT="0.1204"
SET TOTALWT="0.0586"
SET DEP=DEP+1
QUIT
+8 ; Interpersonal Problems
+9 IF (DES=4)
SET INTERWT="0.1583"
SET TOTALWT="0.0251"
SET INTER=INTER+1
QUIT
+10 IF (DES=5)
SET INTERWT="0.3299"
SET TOTALWT="0.0279"
SET INTER=INTER+1
QUIT
+11 IF (DES=6)
SET INTERWT="0.2754"
SET TOTALWT="0.0297"
SET INTER=INTER+1
QUIT
+12 IF (DES=7)
SET INTERWT="0.1362"
SET TOTALWT="0.027"
SET INTER=INTER+1
QUIT
+13 IF (DES=8)
SET INTERWT="0.1002"
SET TOTALWT="0.0241"
SET INTER=INTER+1
QUIT
+14 ; Psycholtic Symptoms
+15 IF (DES=14)
SET PSYWT="0.1049"
SET TOTALWT="0.0164"
SET PSY=PSY+1
QUIT
+16 IF (DES=15)
SET PSYWT="0.136"
SET TOTALWT="0.023"
SET PSY=PSY+1
QUIT
+17 IF (DES=16)
SET PSYWT="0.4636"
SET TOTALWT="0.0243"
SET PSY=PSY+1
QUIT
+18 IF (DES=17)
SET PSYWT="0.2955"
SET TOTALWT="0.0304"
SET PSY=PSY+1
QUIT
+19 ; Alcohol/Drug Use
+20 IF (DES=21)
SET ALCWT="0.34"
SET TOTALWT="0.0178"
SET ALC=ALC+1
QUIT
+21 IF (DES=22)
SET ALCWT="0.234"
SET TOTALWT="0.0135"
SET ALC=ALC+1
QUIT
+22 IF (DES=23)
SET ALCWT="0.1556"
SET TOTALWT="0.01"
SET ALC=ALC+1
QUIT
+23 IF (DES=24)
SET ALCWT="0.2704"
SET TOTALWT="0.0128"
SET ALC=ALC+1
QUIT
+24 ; Emotional Liability
+25 IF (DES=13)
SET EMOWT="11.02"
SET TOTALWT="0.0384"
SET EMO=EMO+1
QUIT
+26 IF (DES=18)
SET EMOWT="61.32"
SET TOTALWT="0.065"
SET EMO=EMO+1
QUIT
+27 IF (DES=19)
SET EMOWT="27.66"
SET TOTALWT="0.0589"
SET EMO=EMO+1
QUIT
+28 ; Self-Harm
+29 IF (DES=11)
SET HARMWT="0.4175"
SET TOTALWT="0.0483"
SET HARM=HARM+1
QUIT
+30 IF (DES=20)
SET HARMWT="0.5825"
SET TOTALWT="0.0524"
SET HARM=HARM+1
QUIT
+31 QUIT
+32 ;
TALLYSUM ;
+1 ; Depression
+2 IF (DES=1)
SET DEPSUM=DEPSUM+(LEG*"0.1860")
SET TOTALSUM=TOTALSUM+(LEG*"0.0696")
QUIT
+3 IF (DES=2)
SET DEPSUM=DEPSUM+(LEG*"0.2612")
SET TOTALSUM=TOTALSUM+(LEG*"0.1061")
QUIT
+4 IF (DES=3)
SET DEPSUM=DEPSUM+(LEG*"0.1763")
SET TOTALSUM=TOTALSUM+(LEG*"0.07")
QUIT
+5 ; Reverse this item
+6 IF (DES=9)
SET DEPSUM=DEPSUM+((4-LEG)*"0.0882")
SET TOTALSUM=TOTALSUM+((4-LEG)*"0.0565")
QUIT
+7 IF (DES=10)
SET DEPSUM=DEPSUM+(LEG*"0.1679")
SET TOTALSUM=TOTALSUM+(LEG*"0.0942")
QUIT
+8 IF (DES=12)
SET DEPSUM=DEPSUM+(LEG*"0.1204")
SET TOTALSUM=TOTALSUM+(LEG*"0.0586")
QUIT
+9 ; Interpersonal Problems: All reversed in scoring
+10 IF (DES=4)
SET INTERSUM=INTERSUM+((4-LEG)*"0.1583")
SET TOTALSUM=TOTALSUM+((4-LEG)*"0.0251")
QUIT
+11 IF (DES=5)
SET INTERSUM=INTERSUM+((4-LEG)*"0.3299")
SET TOTALSUM=TOTALSUM+((4-LEG)*"0.0279")
QUIT
+12 IF (DES=6)
SET INTERSUM=INTERSUM+((4-LEG)*"0.2754")
SET TOTALSUM=TOTALSUM+((4-LEG)*"0.0297")
QUIT
+13 IF (DES=7)
SET INTERSUM=INTERSUM+((4-LEG)*"0.1362")
SET TOTALSUM=TOTALSUM+((4-LEG)*"0.027")
QUIT
+14 IF (DES=8)
SET INTERSUM=INTERSUM+((4-LEG)*"0.1002")
SET TOTALSUM=TOTALSUM+((4-LEG)*"0.0241")
QUIT
+15 ; Psycholtic Symptoms
+16 IF (DES=14)
SET PSYSUM=PSYSUM+(LEG*"0.1049")
SET TOTALSUM=TOTALSUM+(LEG*"0.0164")
QUIT
+17 IF (DES=15)
SET PSYSUM=PSYSUM+(LEG*"0.136")
SET TOTALSUM=TOTALSUM+(LEG*"0.023")
QUIT
+18 IF (DES=16)
SET PSYSUM=PSYSUM+(LEG*"0.4636")
SET TOTALSUM=TOTALSUM+(LEG*"0.0243")
QUIT
+19 IF (DES=17)
SET PSYSUM=PSYSUM+(LEG*"0.2955")
SET TOTALSUM=TOTALSUM+(LEG*"0.0304")
QUIT
+20 ; Alcohol/Drug Use
+21 IF (DES=21)
SET ALCSUM=ALCSUM+(LEG*"0.34")
SET TOTALSUM=TOTALSUM+(LEG*"0.0178")
QUIT
+22 IF (DES=22)
SET ALCSUM=ALCSUM+(LEG*"0.234")
SET TOTALSUM=TOTALSUM+(LEG*"0.0135")
QUIT
+23 IF (DES=23)
SET ALCSUM=ALCSUM+(LEG*"0.1556")
SET TOTALSUM=TOTALSUM+(LEG*"0.01")
QUIT
+24 IF (DES=24)
SET ALCSUM=ALCSUM+(LEG*"0.2704")
SET TOTALSUM=TOTALSUM+(LEG*"0.0128")
QUIT
+25 ; Emotional Liability
+26 IF (DES=13)
SET EMOSUM=EMOSUM+(LEG*"0.1102")
SET TOTALSUM=TOTALSUM+(LEG*"0.0384")
QUIT
+27 IF (DES=18)
SET EMOSUM=EMOSUM+(LEG*"0.6132")
SET TOTALSUM=TOTALSUM+(LEG*"0.065")
QUIT
+28 IF (DES=19)
SET EMOSUM=EMOSUM+(LEG*"0.2766")
SET TOTALSUM=TOTALSUM+(LEG*"0.0589")
QUIT
+29 ; Self Harm
+30 IF (DES=11)
SET HARMSUM=HARMSUM+(LEG*"0.4175")
SET TOTALSUM=TOTALSUM+(LEG*"0.0483")
QUIT
+31 IF (DES=20)
SET HARMSUM=HARMSUM+(LEG*"0.5825")
SET TOTALSUM=TOTALSUM+(LEG*"0.0524")
QUIT
+32 QUIT
+33 ;
TOTCAL ;
+1 IF (DEP=0)
SET DEPSUM=$JUSTIFY(DEPSUM,0,2)
+2 IF (DEP=1)
SET DEPSUM=$JUSTIFY((DEPSUM/(1-DEPWT)),0,2)
+3 IF (DEP>1)
SET DEPSUM="Too many skipped questions"
+4 ;
+5 IF (INTER=0)
SET INTERSUM=$JUSTIFY(INTERSUM,0,2)
+6 IF (INTER=1)
SET INTERSUM=$JUSTIFY((INTERSUM/(1-INTERWT)),0,2)
+7 IF (INTER>1)
SET INTERSUM="Too many skipped questions"
+8 ;
+9 IF (PSY=0)
SET PSYSUM=$JUSTIFY(PSYSUM,0,2)
+10 IF (PSY=1)
SET PSYSUM=$JUSTIFY(PSYSUM/(1-PSYWT),0,2)
+11 IF (PSY>1)
SET PSYSUM="Too many skipped questions"
+12 ;
+13 IF (ALC=0)
SET ALCSUM=$JUSTIFY(ALCSUM,0,2)
+14 IF (ALC=1)
SET ALCSUM=$JUSTIFY((ALCSUM/(1-ALCWT)),0,2)
+15 IF (ALC>1)
SET ALCSUM="Too many skipped questions"
+16 ;
+17 IF (EMO=0)
SET EMOSUM=$JUSTIFY(EMOSUM,0,2)
+18 IF (EMO=1)
SET EMOSUM=$JUSTIFY((EMOSUM/(1-EMOWT)),0,2)
+19 IF (EMO>1)
SET EMOSUM="Too many skipped questions"
+20 ;
+21 IF (HARM=0)
SET HARMSUM=$JUSTIFY(HARMSUM,0,2)
+22 IF (HARM=1)
SET HARMSUM=$JUSTIFY((HARMSUM/(1-HARMWT)),0,2)
+23 IF (HARM>1)
SET HARMSUM="Too many skipped questions"
+24 ;
+25 IF (DEP+INTER+PSY+ALC+EMO+HARM)=0
SET TOTALSUM=$JUSTIFY(TOTALSUM,0,2)
+26 IF (DEP+INTER+PSY+ALC+EMO+HARM)=1
SET TOTALSUM=$JUSTIFY((TOTALSUM/(1-TOTALWT)),0,2)
+27 IF (DEP+INTER+PSY+ALC+EMO+HARM)>1
SET TOTALSUM="Too many skipped questions"
+28 QUIT
+29 ;
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 ; Scale Name
SET YSSCNAM=$PIECE($GET(^TMP($JOB,"YSG",3)),U,4)
+7 KILL ^TMP($JOB,"YSCOR")
+8 SET ^TMP($JOB,"YSCOR",1)="[DATA]"
+9 SET ^TMP($JOB,"YSCOR",2)=$$GET1^DIQ(601.87,596_",",3,"I")_"="_$JUSTIFY(DEPSUM,0,2)
+10 SET ^TMP($JOB,"YSCOR",3)=$$GET1^DIQ(601.87,597_",",3,"I")_"="_$JUSTIFY(INTERSUM,0,2)
+11 SET ^TMP($JOB,"YSCOR",4)=$$GET1^DIQ(601.87,598_",",3,"I")_"="_$JUSTIFY(PSYSUM,0,2)
+12 SET ^TMP($JOB,"YSCOR",5)=$$GET1^DIQ(601.87,599_",",3,"I")_"="_$JUSTIFY(ALCSUM,0,2)
+13 SET ^TMP($JOB,"YSCOR",6)=$$GET1^DIQ(601.87,600_",",3,"I")_"="_$JUSTIFY(EMOSUM,0,2)
+14 SET ^TMP($JOB,"YSCOR",7)=$$GET1^DIQ(601.87,601_",",3,"I")_"="_$JUSTIFY(HARMSUM,0,2)
+15 SET ^TMP($JOB,"YSCOR",8)=$$GET1^DIQ(601.87,602_",",3,"I")_"="_$JUSTIFY(TOTALSUM,0,2)
+16 QUIT
+17 ;
DLLSTR(YSDATA,YS,YSTRNG) ;
+1 ; YSTRNG = 1 Score Instrument
+2 ; YSTRNG = 2 get Report Answers and Text)
+3 NEW DATA,DES,LEG,NODE,YSQN
+4 NEW YSCDA,YSSCNAM,YSINSNAM,YSSEQ,STRING
+5 NEW ALCWT,DEPWT,EMOWT,HARMWT,INTERWT,PSYWT,TOTALWT
+6 NEW DEP,INTER,PSY,ALC,EMO,HARM,TOTAL
+7 NEW DEPSUM,INTERSUM,PSYSUM,ALCSUM,EMOSUM,HARMSUM,TOTALSUM
+8 NEW DEPSC,INTERSC,PSYSC,ALCSC,EMOSC,HARMSC,TOTALSC,RESULT
+9 ;
+10 SET (ALCWT,DEPWT,EMOWT,HARMWT,INTERWT,PSYWT,TOTALWT)=0
+11 SET (DEP,INTER,PSY,ALC,EMO,HARM,TOTAL)=0
+12 SET (DEPSUM,INTERSUM,PSYSUM,ALCSUM,EMOSUM,HARMSUM,TOTALSUM)=0
+13 SET (DEPSC,INTERSC,PSYSC,ALCSC,EMOSC,HARMSC,TOTALSC,RESULT)=0
+14 ;
+15 SET STRING=""
+16 ;
+17 ;BASIS-24 returns scale scores which are calculated and stored, all special text in MH REPORT File
+18 IF YSTRNG=2
QUIT
+19 ;
+20 DO DATA1
+21 DO SCORESV
+22 QUIT
