161 lines
4.5 KiB
Mathematica
161 lines
4.5 KiB
Mathematica
YSASCSA ;692/DCL-ASI COMPOSITE SCORES;MAY 09, 1996@11:47 ;6/24/97 09:39
|
|
;;5.01;MENTAL HEALTH;**24,30**;Dec 30, 1994
|
|
Q
|
|
;
|
|
IF(YSASIEN,YSASFLD,YSASFLG) ;pass ien and field - return content
|
|
Q:$G(YSASIEN)'>0 ""
|
|
Q:$G(YSASFLD)'>0 ""
|
|
N DIERR
|
|
Q $$GET1^DIQ(604,YSASIEN_",",YSASFLD,$G(YSASFLG))
|
|
;
|
|
CSMS(YSASDA) ;Composit Score for Medical Status
|
|
N YSASA,YSASB,YSASC,YSASI
|
|
S YSASA=$$IF(YSASDA,8.08)
|
|
Q:YSASA'?1N.N ""
|
|
S YSASB=$$IF(YSASDA,8.09)
|
|
Q:YSASB'?1N.N ""
|
|
S YSASC=$$IF(YSASDA,8.11)
|
|
Q:YSASC'?1N.N ""
|
|
;S YSASA=YSASA/30,YSASB=YSASB/4,YSASC=YSASC/4
|
|
Q (YSASA/90)+(YSASB/12)+(YSASC/12)
|
|
;
|
|
CSES(YSASDA) ;Composit Score for Employment Status
|
|
N YSASA,YSASB,YSASC,YSASD,YSASI
|
|
S YSASA=$$IF(YSASDA,9.06,"I")
|
|
Q:YSASA'?1N.N ""
|
|
S YSASB=$$IF(YSASDA,9.09,"I")
|
|
Q:YSASB'?1N.N ""
|
|
S YSASC=$$IF(YSASDA,9.18)
|
|
Q:YSASC'?1N.N ""
|
|
S YSASD=$$IF(YSASDA,9.19)
|
|
Q:YSASD'?1N.N ""
|
|
S:YSASD>0 YSASD=$$LN^XLFMTH(YSASD)
|
|
S YSASA=YSASA/4,YSASB=YSASB/4,YSASC=YSASC/120,YSASD=YSASD/36
|
|
Q 1.000-(YSASA+YSASB+YSASC+YSASD)
|
|
;
|
|
CSA(YSASDA) ;Composit Score for Alcohol
|
|
N YSASA,YSASB,YSASC,YSASD,YSASE,YSASF
|
|
S YSASA=$$IF(YSASDA,10.01)
|
|
Q:YSASA'?1N.N ""
|
|
S YSASB=$$IF(YSASDA,10.04)
|
|
Q:YSASB'?1N.N ""
|
|
S YSASC=$$IF(YSASDA,11.14)
|
|
Q:YSASC'?1N.N ""
|
|
S YSASD=$$IF(YSASDA,11.16)
|
|
Q:YSASD'?1N.N ""
|
|
S YSASE=$$IF(YSASDA,11.165)
|
|
Q:YSASE'?1N.N ""
|
|
S YSASF=$$IF(YSASDA,11.09)
|
|
Q:YSASF'?1N.N ""
|
|
S:YSASF>0 YSASF=$$LN^XLFMTH(YSASF)
|
|
S YSASA=YSASA/180,YSASB=YSASB/180,YSASC=YSASC/180,YSASD=YSASD/24
|
|
S YSASE=YSASE/24,YSASF=YSASF/44
|
|
Q YSASA+YSASB+YSASC+YSASD+YSASE+YSASF
|
|
;
|
|
CSD(YSASDA) ;Composit Score for Drug
|
|
N YSASA,YSASB,YSASC,YSASD,YSASE,YSASF,YSASG,YSASH,YSASI,YSASJ,YSASK,YSASL,YSASM
|
|
S YSASA=$$IF(YSASDA,10.07)
|
|
Q:YSASA'?1N.N ""
|
|
S YSASB=$$IF(YSASDA,10.11)
|
|
Q:YSASB'?1N.N ""
|
|
S YSASC=$$IF(YSASDA,10.15)
|
|
Q:YSASC'?1N.N ""
|
|
S YSASD=$$IF(YSASDA,10.18)
|
|
Q:YSASD'?1N.N ""
|
|
S YSASE=$$IF(YSASDA,10.22)
|
|
Q:YSASE'?1N.N ""
|
|
S YSASF=$$IF(YSASDA,10.25)
|
|
Q:YSASF'?1N.N ""
|
|
S YSASG=$$IF(YSASDA,10.28)
|
|
Q:YSASG'?1N.N ""
|
|
S YSASH=$$IF(YSASDA,10.32)
|
|
Q:YSASH'?1N.N ""
|
|
S YSASI=$$IF(YSASDA,10.35)
|
|
Q:YSASI'?1N.N ""
|
|
S YSASJ=$$IF(YSASDA,10.42)
|
|
Q:YSASJ'?1N.N ""
|
|
S YSASK=$$IF(YSASDA,11.15)
|
|
Q:YSASK'?1N.N ""
|
|
S YSASL=$$IF(YSASDA,11.17)
|
|
Q:YSASL'?1N.N ""
|
|
S YSASM=$$IF(YSASDA,11.175)
|
|
Q:YSASM'?1N.N ""
|
|
S YSASA=YSASA/390,YSASB=YSASB/390,YSASC=YSASC/390,YSASD=YSASD/390
|
|
S YSASE=YSASE/390,YSASF=YSASF/390,YSASG=YSASG/390,YSASH=YSASH/390
|
|
S YSASI=YSASI/390,YSASJ=YSASJ/390,YSASK=YSASK/390,YSASL=YSASL/52
|
|
S YSASM=YSASM/52
|
|
Q YSASA+YSASB+YSASC+YSASD+YSASE+YSASF+YSASG+YSASH+YSASI+YSASJ+YSASK+YSASL+YSASM
|
|
;
|
|
CSLS(YSASDA) ;Composite Score for Legal Status
|
|
N YSASA,YSASB,YSASC,YSASD,YSASE
|
|
S YSASA=$$IF(YSASDA,14.27,"I")
|
|
Q:YSASA'?1N.N ""
|
|
S YSASB=$$IF(YSASDA,14.31)
|
|
Q:YSASB'?1N.N ""
|
|
S YSASC=$$IF(YSASDA,14.32)
|
|
Q:YSASC'?1N.N ""
|
|
S YSASD=$$IF(YSASDA,14.33)
|
|
Q:YSASD'?1N.N ""
|
|
S YSASE=$$IF(YSASDA,9.25)
|
|
Q:YSASE'?1N.N ""
|
|
S:YSASE>0 YSASE=$$LN^XLFMTH(YSASE)
|
|
S YSASA=YSASA/5,YSASB=YSASB/150,YSASC=YSASC/20,YSASD=YSASD/20
|
|
S YSASE=YSASE/46
|
|
Q YSASA+YSASB+YSASC+YSASD+YSASE
|
|
;
|
|
CSFSR(YSASDA) ;Composite Score for Family/Social Relationships
|
|
N YSASA,YSASB,YSASC,YSASD,YSASR,YSASDEMN
|
|
S YSASA=$$IF(YSASDA,17.04,"I")
|
|
Q:YSASA'?1N.N ""
|
|
S YSASB=$$IF(YSASDA,18.23)
|
|
Q:YSASB'?1N.N ""
|
|
S YSASC=$$IF(YSASDA,18.25)
|
|
Q:YSASC'?1N.N ""
|
|
S YSASD=$$IF(YSASDA,18.27)
|
|
Q:YSASD'?1N.N ""
|
|
D
|
|
.N YSASI,YSASX
|
|
.S YSASR=0,YSASDEMN=0
|
|
.F YSASI=.01,.03,.05,.07,.09,.12,.15,.17,.185 D Q:YSASR=""
|
|
..S YSASX=$$IF(YSASDA,18_YSASI,"I")
|
|
..I YSASX="" S YSASR="" Q
|
|
..S YSASR=YSASR+YSASX S:YSASX?1N YSASDEMN=YSASDEMN+1
|
|
..Q
|
|
.S:YSASDEMN YSASR=YSASR/YSASDEMN
|
|
.Q
|
|
Q:YSASR'?1NP.N ""
|
|
S YSASA=$S(YSASA=2:0,YSASA=0:2,1:1)
|
|
S YSASA=YSASA/10,YSASB=YSASB/150,YSASC=YSASC/20,YSASD=YSASD/20
|
|
S YSASR=YSASR/5
|
|
Q YSASA+YSASB+YSASC+YSASD+YSASR
|
|
;
|
|
CSPS(YSASDA) ;Composite Score for Psychiatric Status
|
|
N YSASA,YSASB,YSASC,YSASD,YSASE,YSASF,YSASG,YSASH,YSASI,YSASJ,YSASK
|
|
S YSASA=$$IF(YSASDA,19.04,"I")
|
|
Q:YSASA'?1N.N ""
|
|
S YSASB=$$IF(YSASDA,19.06,"I")
|
|
Q:YSASB'?1N.N ""
|
|
S YSASC=$$IF(YSASDA,19.08,"I")
|
|
Q:YSASC'?1N.N ""
|
|
S YSASD=$$IF(YSASDA,19.11,"I")
|
|
Q:YSASD'?1N.N ""
|
|
S YSASE=$$IF(YSASDA,19.14,"I")
|
|
Q:YSASE'?1N.N ""
|
|
S YSASF=$$IF(YSASDA,19.16,"I")
|
|
Q:YSASF'?1N.N ""
|
|
S YSASG=$$IF(YSASDA,19.18,"I")
|
|
Q:YSASG'?1N.N ""
|
|
S YSASH=$$IF(YSASDA,19.21,"I")
|
|
Q:YSASH'?1N.N ""
|
|
S YSASI=$$IF(YSASDA,19.23)
|
|
Q:YSASI'?1N.N ""
|
|
S YSASJ=$$IF(YSASDA,19.24)
|
|
Q:YSASJ'?1N.N ""
|
|
S YSASK=$$IF(YSASDA,19.25)
|
|
Q:YSASK'?1N.N ""
|
|
S YSASA=YSASA/11,YSASB=YSASB/11,YSASC=YSASC/11,YSASD=YSASD/11
|
|
S YSASE=YSASE/11,YSASF=YSASF/11,YSASG=YSASG/11,YSASH=YSASH/11
|
|
S YSASI=YSASI/330,YSASJ=YSASJ/44,YSASK=YSASK/44
|
|
Q YSASA+YSASB+YSASC+YSASD+YSASE+YSASF+YSASG+YSASH+YSASI+YSASJ+YSASK
|
|
;
|