source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSASCSA.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.5 KB
Line 
1YSASCSA ;692/DCL-ASI COMPOSITE SCORES;MAY 09, 1996@11:47 ;6/24/97 09:39
2 ;;5.01;MENTAL HEALTH;**24,30**;Dec 30, 1994
3 Q
4 ;
5IF(YSASIEN,YSASFLD,YSASFLG) ;pass ien and field - return content
6 Q:$G(YSASIEN)'>0 ""
7 Q:$G(YSASFLD)'>0 ""
8 N DIERR
9 Q $$GET1^DIQ(604,YSASIEN_",",YSASFLD,$G(YSASFLG))
10 ;
11CSMS(YSASDA) ;Composit Score for Medical Status
12 N YSASA,YSASB,YSASC,YSASI
13 S YSASA=$$IF(YSASDA,8.08)
14 Q:YSASA'?1N.N ""
15 S YSASB=$$IF(YSASDA,8.09)
16 Q:YSASB'?1N.N ""
17 S YSASC=$$IF(YSASDA,8.11)
18 Q:YSASC'?1N.N ""
19 ;S YSASA=YSASA/30,YSASB=YSASB/4,YSASC=YSASC/4
20 Q (YSASA/90)+(YSASB/12)+(YSASC/12)
21 ;
22CSES(YSASDA) ;Composit Score for Employment Status
23 N YSASA,YSASB,YSASC,YSASD,YSASI
24 S YSASA=$$IF(YSASDA,9.06,"I")
25 Q:YSASA'?1N.N ""
26 S YSASB=$$IF(YSASDA,9.09,"I")
27 Q:YSASB'?1N.N ""
28 S YSASC=$$IF(YSASDA,9.18)
29 Q:YSASC'?1N.N ""
30 S YSASD=$$IF(YSASDA,9.19)
31 Q:YSASD'?1N.N ""
32 S:YSASD>0 YSASD=$$LN^XLFMTH(YSASD)
33 S YSASA=YSASA/4,YSASB=YSASB/4,YSASC=YSASC/120,YSASD=YSASD/36
34 Q 1.000-(YSASA+YSASB+YSASC+YSASD)
35 ;
36CSA(YSASDA) ;Composit Score for Alcohol
37 N YSASA,YSASB,YSASC,YSASD,YSASE,YSASF
38 S YSASA=$$IF(YSASDA,10.01)
39 Q:YSASA'?1N.N ""
40 S YSASB=$$IF(YSASDA,10.04)
41 Q:YSASB'?1N.N ""
42 S YSASC=$$IF(YSASDA,11.14)
43 Q:YSASC'?1N.N ""
44 S YSASD=$$IF(YSASDA,11.16)
45 Q:YSASD'?1N.N ""
46 S YSASE=$$IF(YSASDA,11.165)
47 Q:YSASE'?1N.N ""
48 S YSASF=$$IF(YSASDA,11.09)
49 Q:YSASF'?1N.N ""
50 S:YSASF>0 YSASF=$$LN^XLFMTH(YSASF)
51 S YSASA=YSASA/180,YSASB=YSASB/180,YSASC=YSASC/180,YSASD=YSASD/24
52 S YSASE=YSASE/24,YSASF=YSASF/44
53 Q YSASA+YSASB+YSASC+YSASD+YSASE+YSASF
54 ;
55CSD(YSASDA) ;Composit Score for Drug
56 N YSASA,YSASB,YSASC,YSASD,YSASE,YSASF,YSASG,YSASH,YSASI,YSASJ,YSASK,YSASL,YSASM
57 S YSASA=$$IF(YSASDA,10.07)
58 Q:YSASA'?1N.N ""
59 S YSASB=$$IF(YSASDA,10.11)
60 Q:YSASB'?1N.N ""
61 S YSASC=$$IF(YSASDA,10.15)
62 Q:YSASC'?1N.N ""
63 S YSASD=$$IF(YSASDA,10.18)
64 Q:YSASD'?1N.N ""
65 S YSASE=$$IF(YSASDA,10.22)
66 Q:YSASE'?1N.N ""
67 S YSASF=$$IF(YSASDA,10.25)
68 Q:YSASF'?1N.N ""
69 S YSASG=$$IF(YSASDA,10.28)
70 Q:YSASG'?1N.N ""
71 S YSASH=$$IF(YSASDA,10.32)
72 Q:YSASH'?1N.N ""
73 S YSASI=$$IF(YSASDA,10.35)
74 Q:YSASI'?1N.N ""
75 S YSASJ=$$IF(YSASDA,10.42)
76 Q:YSASJ'?1N.N ""
77 S YSASK=$$IF(YSASDA,11.15)
78 Q:YSASK'?1N.N ""
79 S YSASL=$$IF(YSASDA,11.17)
80 Q:YSASL'?1N.N ""
81 S YSASM=$$IF(YSASDA,11.175)
82 Q:YSASM'?1N.N ""
83 S YSASA=YSASA/390,YSASB=YSASB/390,YSASC=YSASC/390,YSASD=YSASD/390
84 S YSASE=YSASE/390,YSASF=YSASF/390,YSASG=YSASG/390,YSASH=YSASH/390
85 S YSASI=YSASI/390,YSASJ=YSASJ/390,YSASK=YSASK/390,YSASL=YSASL/52
86 S YSASM=YSASM/52
87 Q YSASA+YSASB+YSASC+YSASD+YSASE+YSASF+YSASG+YSASH+YSASI+YSASJ+YSASK+YSASL+YSASM
88 ;
89CSLS(YSASDA) ;Composite Score for Legal Status
90 N YSASA,YSASB,YSASC,YSASD,YSASE
91 S YSASA=$$IF(YSASDA,14.27,"I")
92 Q:YSASA'?1N.N ""
93 S YSASB=$$IF(YSASDA,14.31)
94 Q:YSASB'?1N.N ""
95 S YSASC=$$IF(YSASDA,14.32)
96 Q:YSASC'?1N.N ""
97 S YSASD=$$IF(YSASDA,14.33)
98 Q:YSASD'?1N.N ""
99 S YSASE=$$IF(YSASDA,9.25)
100 Q:YSASE'?1N.N ""
101 S:YSASE>0 YSASE=$$LN^XLFMTH(YSASE)
102 S YSASA=YSASA/5,YSASB=YSASB/150,YSASC=YSASC/20,YSASD=YSASD/20
103 S YSASE=YSASE/46
104 Q YSASA+YSASB+YSASC+YSASD+YSASE
105 ;
106CSFSR(YSASDA) ;Composite Score for Family/Social Relationships
107 N YSASA,YSASB,YSASC,YSASD,YSASR,YSASDEMN
108 S YSASA=$$IF(YSASDA,17.04,"I")
109 Q:YSASA'?1N.N ""
110 S YSASB=$$IF(YSASDA,18.23)
111 Q:YSASB'?1N.N ""
112 S YSASC=$$IF(YSASDA,18.25)
113 Q:YSASC'?1N.N ""
114 S YSASD=$$IF(YSASDA,18.27)
115 Q:YSASD'?1N.N ""
116 D
117 .N YSASI,YSASX
118 .S YSASR=0,YSASDEMN=0
119 .F YSASI=.01,.03,.05,.07,.09,.12,.15,.17,.185 D Q:YSASR=""
120 ..S YSASX=$$IF(YSASDA,18_YSASI,"I")
121 ..I YSASX="" S YSASR="" Q
122 ..S YSASR=YSASR+YSASX S:YSASX?1N YSASDEMN=YSASDEMN+1
123 ..Q
124 .S:YSASDEMN YSASR=YSASR/YSASDEMN
125 .Q
126 Q:YSASR'?1NP.N ""
127 S YSASA=$S(YSASA=2:0,YSASA=0:2,1:1)
128 S YSASA=YSASA/10,YSASB=YSASB/150,YSASC=YSASC/20,YSASD=YSASD/20
129 S YSASR=YSASR/5
130 Q YSASA+YSASB+YSASC+YSASD+YSASR
131 ;
132CSPS(YSASDA) ;Composite Score for Psychiatric Status
133 N YSASA,YSASB,YSASC,YSASD,YSASE,YSASF,YSASG,YSASH,YSASI,YSASJ,YSASK
134 S YSASA=$$IF(YSASDA,19.04,"I")
135 Q:YSASA'?1N.N ""
136 S YSASB=$$IF(YSASDA,19.06,"I")
137 Q:YSASB'?1N.N ""
138 S YSASC=$$IF(YSASDA,19.08,"I")
139 Q:YSASC'?1N.N ""
140 S YSASD=$$IF(YSASDA,19.11,"I")
141 Q:YSASD'?1N.N ""
142 S YSASE=$$IF(YSASDA,19.14,"I")
143 Q:YSASE'?1N.N ""
144 S YSASF=$$IF(YSASDA,19.16,"I")
145 Q:YSASF'?1N.N ""
146 S YSASG=$$IF(YSASDA,19.18,"I")
147 Q:YSASG'?1N.N ""
148 S YSASH=$$IF(YSASDA,19.21,"I")
149 Q:YSASH'?1N.N ""
150 S YSASI=$$IF(YSASDA,19.23)
151 Q:YSASI'?1N.N ""
152 S YSASJ=$$IF(YSASDA,19.24)
153 Q:YSASJ'?1N.N ""
154 S YSASK=$$IF(YSASDA,19.25)
155 Q:YSASK'?1N.N ""
156 S YSASA=YSASA/11,YSASB=YSASB/11,YSASC=YSASC/11,YSASD=YSASD/11
157 S YSASE=YSASE/11,YSASF=YSASF/11,YSASG=YSASG/11,YSASH=YSASH/11
158 S YSASI=YSASI/330,YSASJ=YSASJ/44,YSASK=YSASK/44
159 Q YSASA+YSASB+YSASC+YSASD+YSASE+YSASF+YSASG+YSASH+YSASI+YSASJ+YSASK
160 ;
Note: See TracBrowser for help on using the repository browser.