Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: YTSISMI

YTSISMI.m

Go to the documentation of this file.
  1. YTSISMI ;SLC/PIJ - Score ISMI ; 01/08/2016
  1. ;;5.01;MENTAL HEALTH;**123**;DEC 30,1994;Build 73
  1. ;
  1. ;Public, Supported ICRs
  1. ; #2056 - Fileman API - $$GET1^DIQ
  1. ;
  1. Q
  1. ;
  1. DATA1 ;
  1. S YSINSNAM=$P($G(YSDATA(2)),U,3)
  1. I $G(YSINSNAM)="" S YSINSNAM=$G(YS("CODE"),"NO NAME PASSED")
  1. S NODE=2 F S NODE=$O(YSDATA(NODE)) Q:NODE="" D ; Start at YSDATA(3)
  1. .S DATA=YSDATA(NODE)
  1. .S YSQN=$P(DATA,U,1)
  1. .S YSCDA=$P($G(DATA),U,3)
  1. .D DESGNTR^YTSCORE(YSQN,.DES)
  1. .;CHOICE ID's aren't correct, manually map
  1. .I YSCDA=780 S LEG=1 ; Strongly Disagree
  1. .I YSCDA=782 S LEG=2 ; Disagree
  1. .I YSCDA=783 S LEG=3 ; Agree
  1. .I YSCDA=785 S LEG=4 ; Strongly Agree
  1. .I (YSCDA<780)!(YSCDA>785) Q ; skipped answers not scored
  1. .; Alien
  1. .I (DES=1)!(DES=5)!(DES=8)!(DES=16)!(DES=17)!(DES=21) D Q
  1. ..S ALIEN=ALIEN+1
  1. ..S TALIEN=TALIEN+LEG
  1. ..S TOTALSUM=TOTALSUM+LEG
  1. .; Stereotypes
  1. .I (DES=2)!(DES=6)!(DES=10)!(DES=18)!(DES=19)!(DES=23)!(DES=29) D Q
  1. ..S STEREO=STEREO+1
  1. ..S TSTEREO=TSTEREO+LEG
  1. ..S TOTALSUM=TOTALSUM+LEG
  1. .; Discriminiation
  1. .I (DES=3)!(DES=15)!(DES=22)!(DES=25)!(DES=28) D Q
  1. ..S DISCRIM=DISCRIM+1
  1. ..S TDISCRIM=TDISCRIM+LEG
  1. ..S TOTALSUM=TOTALSUM+LEG
  1. .; Social Withdrawal
  1. .I (DES=4)!(DES=9)!(DES=11)!(DES=12)!(DES=13)!(DES=20) D Q
  1. ..S WITHDRAW=WITHDRAW+1
  1. ..S TWITHDR=TWITHDR+LEG
  1. ..S TOTALSUM=TOTALSUM+LEG
  1. .; Stigma Resistance: reverse score before adding to total
  1. .I (DES=7)!(DES=14)!(DES=24)!(DES=26)!(DES=27) D Q
  1. ..S RESIST=RESIST+1
  1. ..S TRESIST=TRESIST+(5-LEG)
  1. ..S TOTALSUM=TOTALSUM+(5-LEG)
  1. Q
  1. ;
  1. TOTAL ;
  1. S TALIEN=$S(ALIEN=0:"All questions skipped",1:$J((TALIEN/ALIEN),0,2))
  1. S TSTEREO=$S(STEREO=0:"All questions skipped",1:$J((TSTEREO/STEREO),0,2))
  1. S TDISCRIM=$S(DISCRIM=0:"All questions skipped",1:$J((TDISCRIM/DISCRIM),0,2))
  1. S TWITHDR=$S(TWITHDR=0:"All questions skipped",1:$J((TWITHDR/WITHDRAW),0,2))
  1. S TRESIST=$S(RESIST=0:"All questions skipped",1:$J((TRESIST/RESIST),0,2))
  1. S TOTALSUM=TOTALSUM/(ALIEN+STEREO+DISCRIM+WITHDRAW+RESIST)
  1. Q
  1. SCORESV ;
  1. I $D(^TMP($J,"YSG",1)),^TMP($J,"YSG",1)="[ERROR]" D Q ;-->out
  1. .K ^TMP($J,"YSCOR")
  1. .S ^TMP($J,"YSCOR",1)="[ERROR]"
  1. .S ^TMP($J,"YSCOR",2)=YSINSNAM_" Scale not found"
  1. ;
  1. K ^TMP($J,"YSCOR")
  1. S ^TMP($J,"YSCOR",1)="[DATA]"
  1. S ^TMP($J,"YSCOR",2)=$$GET1^DIQ(601.87,589_",",3,"I")_"="_TALIEN
  1. S ^TMP($J,"YSCOR",3)=$$GET1^DIQ(601.87,590_",",3,"I")_"="_TSTEREO
  1. S ^TMP($J,"YSCOR",4)=$$GET1^DIQ(601.87,591_",",3,"I")_"="_TDISCRIM
  1. S ^TMP($J,"YSCOR",5)=$$GET1^DIQ(601.87,592_",",3,"I")_"="_TWITHDR
  1. S ^TMP($J,"YSCOR",6)=$$GET1^DIQ(601.87,593_",",3,"I")_"="_TRESIST
  1. S ^TMP($J,"YSCOR",7)=$$GET1^DIQ(601.87,594_",",3,"I")_"="_$J(TOTALSUM,0,2)
  1. Q
  1. ;
  1. DLLSTR(YSDATA,YS,YSTRNG) ;
  1. ; YSTRNG = 1 Score Instrument
  1. ; YSTRNG = 2 get Report Answers and Text
  1. N DATA,DES,NODE,LEG,YSQN,YSCDA,YSINSNAM
  1. N ALIEN,STEREO,DISCRIM,WITHDRAW,RESIST
  1. N TOTAL,TALIEN,TSTEREO,TDISCRIM,TWITHDR,TRESIST,TOTALSUM
  1. ;
  1. S (ALIEN,STEREO,DISCRIM,WITHDRAW,RESIST)=0
  1. S (TOTAL,TALIEN,TSTEREO,TDISCRIM,TWITHDR,TRESIST,TOTALSUM)=0
  1. ;
  1. I YSTRNG=2 Q ; no special text in the report
  1. ;
  1. D DATA1
  1. D TOTAL
  1. D SCORESV
  1. Q