- 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 Feb 18, 2025@23:45:39 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