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
 ;