YTSISMI ;SLC/PIJ - Score ISMI ; 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 YSCDA=$P($G(DATA),U,3)
.D DESGNTR^YTSCORE(YSQN,.DES)
.;CHOICE ID's aren't correct, manually map
.I YSCDA=780 S LEG=1 ; Strongly Disagree
.I YSCDA=782 S LEG=2 ; Disagree
.I YSCDA=783 S LEG=3 ; Agree
.I YSCDA=785 S LEG=4 ; Strongly Agree
.I (YSCDA<780)!(YSCDA>785) Q ; skipped answers not scored
.; Alien
.I (DES=1)!(DES=5)!(DES=8)!(DES=16)!(DES=17)!(DES=21) D Q
..S ALIEN=ALIEN+1
..S TALIEN=TALIEN+LEG
..S TOTALSUM=TOTALSUM+LEG
.; Stereotypes
.I (DES=2)!(DES=6)!(DES=10)!(DES=18)!(DES=19)!(DES=23)!(DES=29) D Q
..S STEREO=STEREO+1
..S TSTEREO=TSTEREO+LEG
..S TOTALSUM=TOTALSUM+LEG
.; Discriminiation
.I (DES=3)!(DES=15)!(DES=22)!(DES=25)!(DES=28) D Q
..S DISCRIM=DISCRIM+1
..S TDISCRIM=TDISCRIM+LEG
..S TOTALSUM=TOTALSUM+LEG
.; Social Withdrawal
.I (DES=4)!(DES=9)!(DES=11)!(DES=12)!(DES=13)!(DES=20) D Q
..S WITHDRAW=WITHDRAW+1
..S TWITHDR=TWITHDR+LEG
..S TOTALSUM=TOTALSUM+LEG
.; Stigma Resistance: reverse score before adding to total
.I (DES=7)!(DES=14)!(DES=24)!(DES=26)!(DES=27) D Q
..S RESIST=RESIST+1
..S TRESIST=TRESIST+(5-LEG)
..S TOTALSUM=TOTALSUM+(5-LEG)
Q
;
TOTAL ;
S TALIEN=$S(ALIEN=0:"All questions skipped",1:$J((TALIEN/ALIEN),0,2))
S TSTEREO=$S(STEREO=0:"All questions skipped",1:$J((TSTEREO/STEREO),0,2))
S TDISCRIM=$S(DISCRIM=0:"All questions skipped",1:$J((TDISCRIM/DISCRIM),0,2))
S TWITHDR=$S(TWITHDR=0:"All questions skipped",1:$J((TWITHDR/WITHDRAW),0,2))
S TRESIST=$S(RESIST=0:"All questions skipped",1:$J((TRESIST/RESIST),0,2))
S TOTALSUM=TOTALSUM/(ALIEN+STEREO+DISCRIM+WITHDRAW+RESIST)
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,589_",",3,"I")_"="_TALIEN
S ^TMP($J,"YSCOR",3)=$$GET1^DIQ(601.87,590_",",3,"I")_"="_TSTEREO
S ^TMP($J,"YSCOR",4)=$$GET1^DIQ(601.87,591_",",3,"I")_"="_TDISCRIM
S ^TMP($J,"YSCOR",5)=$$GET1^DIQ(601.87,592_",",3,"I")_"="_TWITHDR
S ^TMP($J,"YSCOR",6)=$$GET1^DIQ(601.87,593_",",3,"I")_"="_TRESIST
S ^TMP($J,"YSCOR",7)=$$GET1^DIQ(601.87,594_",",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,NODE,LEG,YSQN,YSCDA,YSINSNAM
N ALIEN,STEREO,DISCRIM,WITHDRAW,RESIST
N TOTAL,TALIEN,TSTEREO,TDISCRIM,TWITHDR,TRESIST,TOTALSUM
;
S (ALIEN,STEREO,DISCRIM,WITHDRAW,RESIST)=0
S (TOTAL,TALIEN,TSTEREO,TDISCRIM,TWITHDR,TRESIST,TOTALSUM)=0
;
I YSTRNG=2 Q ; no special text in the report
;
D DATA1
D TOTAL
D SCORESV
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTSISMI 3129 printed Apr 09, 2024@21:20:37 Page 2
YTSISMI ;SLC/PIJ - Score ISMI ; 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 YSCDA=$PIECE($GET(DATA),U,3)
+7 DO DESGNTR^YTSCORE(YSQN,.DES)
+8 ;CHOICE ID's aren't correct, manually map
+9 ; Strongly Disagree
IF YSCDA=780
SET LEG=1
+10 ; Disagree
IF YSCDA=782
SET LEG=2
+11 ; Agree
IF YSCDA=783
SET LEG=3
+12 ; Strongly Agree
IF YSCDA=785
SET LEG=4
+13 ; skipped answers not scored
IF (YSCDA<780)!(YSCDA>785)
QUIT
+14 ; Alien
+15 IF (DES=1)!(DES=5)!(DES=8)!(DES=16)!(DES=17)!(DES=21)
Begin DoDot:2
+16 SET ALIEN=ALIEN+1
+17 SET TALIEN=TALIEN+LEG
+18 SET TOTALSUM=TOTALSUM+LEG
End DoDot:2
QUIT
+19 ; Stereotypes
+20 IF (DES=2)!(DES=6)!(DES=10)!(DES=18)!(DES=19)!(DES=23)!(DES=29)
Begin DoDot:2
+21 SET STEREO=STEREO+1
+22 SET TSTEREO=TSTEREO+LEG
+23 SET TOTALSUM=TOTALSUM+LEG
End DoDot:2
QUIT
+24 ; Discriminiation
+25 IF (DES=3)!(DES=15)!(DES=22)!(DES=25)!(DES=28)
Begin DoDot:2
+26 SET DISCRIM=DISCRIM+1
+27 SET TDISCRIM=TDISCRIM+LEG
+28 SET TOTALSUM=TOTALSUM+LEG
End DoDot:2
QUIT
+29 ; Social Withdrawal
+30 IF (DES=4)!(DES=9)!(DES=11)!(DES=12)!(DES=13)!(DES=20)
Begin DoDot:2
+31 SET WITHDRAW=WITHDRAW+1
+32 SET TWITHDR=TWITHDR+LEG
+33 SET TOTALSUM=TOTALSUM+LEG
End DoDot:2
QUIT
+34 ; Stigma Resistance: reverse score before adding to total
+35 IF (DES=7)!(DES=14)!(DES=24)!(DES=26)!(DES=27)
Begin DoDot:2
+36 SET RESIST=RESIST+1
+37 SET TRESIST=TRESIST+(5-LEG)
+38 SET TOTALSUM=TOTALSUM+(5-LEG)
End DoDot:2
QUIT
End DoDot:1
+39 QUIT
+40 ;
TOTAL ;
+1 SET TALIEN=$SELECT(ALIEN=0:"All questions skipped",1:$JUSTIFY((TALIEN/ALIEN),0,2))
+2 SET TSTEREO=$SELECT(STEREO=0:"All questions skipped",1:$JUSTIFY((TSTEREO/STEREO),0,2))
+3 SET TDISCRIM=$SELECT(DISCRIM=0:"All questions skipped",1:$JUSTIFY((TDISCRIM/DISCRIM),0,2))
+4 SET TWITHDR=$SELECT(TWITHDR=0:"All questions skipped",1:$JUSTIFY((TWITHDR/WITHDRAW),0,2))
+5 SET TRESIST=$SELECT(RESIST=0:"All questions skipped",1:$JUSTIFY((TRESIST/RESIST),0,2))
+6 SET TOTALSUM=TOTALSUM/(ALIEN+STEREO+DISCRIM+WITHDRAW+RESIST)
+7 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,589_",",3,"I")_"="_TALIEN
+9 SET ^TMP($JOB,"YSCOR",3)=$$GET1^DIQ(601.87,590_",",3,"I")_"="_TSTEREO
+10 SET ^TMP($JOB,"YSCOR",4)=$$GET1^DIQ(601.87,591_",",3,"I")_"="_TDISCRIM
+11 SET ^TMP($JOB,"YSCOR",5)=$$GET1^DIQ(601.87,592_",",3,"I")_"="_TWITHDR
+12 SET ^TMP($JOB,"YSCOR",6)=$$GET1^DIQ(601.87,593_",",3,"I")_"="_TRESIST
+13 SET ^TMP($JOB,"YSCOR",7)=$$GET1^DIQ(601.87,594_",",3,"I")_"="_$JUSTIFY(TOTALSUM,0,2)
+14 QUIT
+15 ;
DLLSTR(YSDATA,YS,YSTRNG) ;
+1 ; YSTRNG = 1 Score Instrument
+2 ; YSTRNG = 2 get Report Answers and Text
+3 NEW DATA,DES,NODE,LEG,YSQN,YSCDA,YSINSNAM
+4 NEW ALIEN,STEREO,DISCRIM,WITHDRAW,RESIST
+5 NEW TOTAL,TALIEN,TSTEREO,TDISCRIM,TWITHDR,TRESIST,TOTALSUM
+6 ;
+7 SET (ALIEN,STEREO,DISCRIM,WITHDRAW,RESIST)=0
+8 SET (TOTAL,TALIEN,TSTEREO,TDISCRIM,TWITHDR,TRESIST,TOTALSUM)=0
+9 ;
+10 ; no special text in the report
IF YSTRNG=2
QUIT
+11 ;
+12 DO DATA1
+13 DO TOTAL
+14 DO SCORESV
+15 QUIT
