- 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 Feb 18, 2025@23:46:14 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