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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSASCSA 4813 printed Apr 09, 2024@21:23:30 Page 2
YSASCSA ;692/DCL-ASI COMPOSITE SCORES;MAY 09, 1996@11:47 ;6/24/97 09:39
+1 ;;5.01;MENTAL HEALTH;**24,30**;Dec 30, 1994
+2 QUIT
+3 ;
IF(YSASIEN,YSASFLD,YSASFLG) ;pass ien and field - return content
+1 if $GET(YSASIEN)'>0
QUIT ""
+2 if $GET(YSASFLD)'>0
QUIT ""
+3 NEW DIERR
+4 QUIT $$GET1^DIQ(604,YSASIEN_",",YSASFLD,$GET(YSASFLG))
+5 ;
CSMS(YSASDA) ;Composit Score for Medical Status
+1 NEW YSASA,YSASB,YSASC,YSASI
+2 SET YSASA=$$IF(YSASDA,8.08)
+3 if YSASA'?1N.N
QUIT ""
+4 SET YSASB=$$IF(YSASDA,8.09)
+5 if YSASB'?1N.N
QUIT ""
+6 SET YSASC=$$IF(YSASDA,8.11)
+7 if YSASC'?1N.N
QUIT ""
+8 ;S YSASA=YSASA/30,YSASB=YSASB/4,YSASC=YSASC/4
+9 QUIT (YSASA/90)+(YSASB/12)+(YSASC/12)
+10 ;
CSES(YSASDA) ;Composit Score for Employment Status
+1 NEW YSASA,YSASB,YSASC,YSASD,YSASI
+2 SET YSASA=$$IF(YSASDA,9.06,"I")
+3 if YSASA'?1N.N
QUIT ""
+4 SET YSASB=$$IF(YSASDA,9.09,"I")
+5 if YSASB'?1N.N
QUIT ""
+6 SET YSASC=$$IF(YSASDA,9.18)
+7 if YSASC'?1N.N
QUIT ""
+8 SET YSASD=$$IF(YSASDA,9.19)
+9 if YSASD'?1N.N
QUIT ""
+10 if YSASD>0
SET YSASD=$$LN^XLFMTH(YSASD)
+11 SET YSASA=YSASA/4
SET YSASB=YSASB/4
SET YSASC=YSASC/120
SET YSASD=YSASD/36
+12 QUIT 1.000-(YSASA+YSASB+YSASC+YSASD)
+13 ;
CSA(YSASDA) ;Composit Score for Alcohol
+1 NEW YSASA,YSASB,YSASC,YSASD,YSASE,YSASF
+2 SET YSASA=$$IF(YSASDA,10.01)
+3 if YSASA'?1N.N
QUIT ""
+4 SET YSASB=$$IF(YSASDA,10.04)
+5 if YSASB'?1N.N
QUIT ""
+6 SET YSASC=$$IF(YSASDA,11.14)
+7 if YSASC'?1N.N
QUIT ""
+8 SET YSASD=$$IF(YSASDA,11.16)
+9 if YSASD'?1N.N
QUIT ""
+10 SET YSASE=$$IF(YSASDA,11.165)
+11 if YSASE'?1N.N
QUIT ""
+12 SET YSASF=$$IF(YSASDA,11.09)
+13 if YSASF'?1N.N
QUIT ""
+14 if YSASF>0
SET YSASF=$$LN^XLFMTH(YSASF)
+15 SET YSASA=YSASA/180
SET YSASB=YSASB/180
SET YSASC=YSASC/180
SET YSASD=YSASD/24
+16 SET YSASE=YSASE/24
SET YSASF=YSASF/44
+17 QUIT YSASA+YSASB+YSASC+YSASD+YSASE+YSASF
+18 ;
CSD(YSASDA) ;Composit Score for Drug
+1 NEW YSASA,YSASB,YSASC,YSASD,YSASE,YSASF,YSASG,YSASH,YSASI,YSASJ,YSASK,YSASL,YSASM
+2 SET YSASA=$$IF(YSASDA,10.07)
+3 if YSASA'?1N.N
QUIT ""
+4 SET YSASB=$$IF(YSASDA,10.11)
+5 if YSASB'?1N.N
QUIT ""
+6 SET YSASC=$$IF(YSASDA,10.15)
+7 if YSASC'?1N.N
QUIT ""
+8 SET YSASD=$$IF(YSASDA,10.18)
+9 if YSASD'?1N.N
QUIT ""
+10 SET YSASE=$$IF(YSASDA,10.22)
+11 if YSASE'?1N.N
QUIT ""
+12 SET YSASF=$$IF(YSASDA,10.25)
+13 if YSASF'?1N.N
QUIT ""
+14 SET YSASG=$$IF(YSASDA,10.28)
+15 if YSASG'?1N.N
QUIT ""
+16 SET YSASH=$$IF(YSASDA,10.32)
+17 if YSASH'?1N.N
QUIT ""
+18 SET YSASI=$$IF(YSASDA,10.35)
+19 if YSASI'?1N.N
QUIT ""
+20 SET YSASJ=$$IF(YSASDA,10.42)
+21 if YSASJ'?1N.N
QUIT ""
+22 SET YSASK=$$IF(YSASDA,11.15)
+23 if YSASK'?1N.N
QUIT ""
+24 SET YSASL=$$IF(YSASDA,11.17)
+25 if YSASL'?1N.N
QUIT ""
+26 SET YSASM=$$IF(YSASDA,11.175)
+27 if YSASM'?1N.N
QUIT ""
+28 SET YSASA=YSASA/390
SET YSASB=YSASB/390
SET YSASC=YSASC/390
SET YSASD=YSASD/390
+29 SET YSASE=YSASE/390
SET YSASF=YSASF/390
SET YSASG=YSASG/390
SET YSASH=YSASH/390
+30 SET YSASI=YSASI/390
SET YSASJ=YSASJ/390
SET YSASK=YSASK/390
SET YSASL=YSASL/52
+31 SET YSASM=YSASM/52
+32 QUIT YSASA+YSASB+YSASC+YSASD+YSASE+YSASF+YSASG+YSASH+YSASI+YSASJ+YSASK+YSASL+YSASM
+33 ;
CSLS(YSASDA) ;Composite Score for Legal Status
+1 NEW YSASA,YSASB,YSASC,YSASD,YSASE
+2 SET YSASA=$$IF(YSASDA,14.27,"I")
+3 if YSASA'?1N.N
QUIT ""
+4 SET YSASB=$$IF(YSASDA,14.31)
+5 if YSASB'?1N.N
QUIT ""
+6 SET YSASC=$$IF(YSASDA,14.32)
+7 if YSASC'?1N.N
QUIT ""
+8 SET YSASD=$$IF(YSASDA,14.33)
+9 if YSASD'?1N.N
QUIT ""
+10 SET YSASE=$$IF(YSASDA,9.25)
+11 if YSASE'?1N.N
QUIT ""
+12 if YSASE>0
SET YSASE=$$LN^XLFMTH(YSASE)
+13 SET YSASA=YSASA/5
SET YSASB=YSASB/150
SET YSASC=YSASC/20
SET YSASD=YSASD/20
+14 SET YSASE=YSASE/46
+15 QUIT YSASA+YSASB+YSASC+YSASD+YSASE
+16 ;
CSFSR(YSASDA) ;Composite Score for Family/Social Relationships
+1 NEW YSASA,YSASB,YSASC,YSASD,YSASR,YSASDEMN
+2 SET YSASA=$$IF(YSASDA,17.04,"I")
+3 if YSASA'?1N.N
QUIT ""
+4 SET YSASB=$$IF(YSASDA,18.23)
+5 if YSASB'?1N.N
QUIT ""
+6 SET YSASC=$$IF(YSASDA,18.25)
+7 if YSASC'?1N.N
QUIT ""
+8 SET YSASD=$$IF(YSASDA,18.27)
+9 if YSASD'?1N.N
QUIT ""
+10 Begin DoDot:1
+11 NEW YSASI,YSASX
+12 SET YSASR=0
SET YSASDEMN=0
+13 FOR YSASI=.01,.03,.05,.07,.09,.12,.15,.17,.185
Begin DoDot:2
+14 SET YSASX=$$IF(YSASDA,18_YSASI,"I")
+15 IF YSASX=""
SET YSASR=""
QUIT
+16 SET YSASR=YSASR+YSASX
if YSASX?1N
SET YSASDEMN=YSASDEMN+1
+17 QUIT
End DoDot:2
if YSASR=""
QUIT
+18 if YSASDEMN
SET YSASR=YSASR/YSASDEMN
+19 QUIT
End DoDot:1
+20 if YSASR'?1NP.N
QUIT ""
+21 SET YSASA=$SELECT(YSASA=2:0,YSASA=0:2,1:1)
+22 SET YSASA=YSASA/10
SET YSASB=YSASB/150
SET YSASC=YSASC/20
SET YSASD=YSASD/20
+23 SET YSASR=YSASR/5
+24 QUIT YSASA+YSASB+YSASC+YSASD+YSASR
+25 ;
CSPS(YSASDA) ;Composite Score for Psychiatric Status
+1 NEW YSASA,YSASB,YSASC,YSASD,YSASE,YSASF,YSASG,YSASH,YSASI,YSASJ,YSASK
+2 SET YSASA=$$IF(YSASDA,19.04,"I")
+3 if YSASA'?1N.N
QUIT ""
+4 SET YSASB=$$IF(YSASDA,19.06,"I")
+5 if YSASB'?1N.N
QUIT ""
+6 SET YSASC=$$IF(YSASDA,19.08,"I")
+7 if YSASC'?1N.N
QUIT ""
+8 SET YSASD=$$IF(YSASDA,19.11,"I")
+9 if YSASD'?1N.N
QUIT ""
+10 SET YSASE=$$IF(YSASDA,19.14,"I")
+11 if YSASE'?1N.N
QUIT ""
+12 SET YSASF=$$IF(YSASDA,19.16,"I")
+13 if YSASF'?1N.N
QUIT ""
+14 SET YSASG=$$IF(YSASDA,19.18,"I")
+15 if YSASG'?1N.N
QUIT ""
+16 SET YSASH=$$IF(YSASDA,19.21,"I")
+17 if YSASH'?1N.N
QUIT ""
+18 SET YSASI=$$IF(YSASDA,19.23)
+19 if YSASI'?1N.N
QUIT ""
+20 SET YSASJ=$$IF(YSASDA,19.24)
+21 if YSASJ'?1N.N
QUIT ""
+22 SET YSASK=$$IF(YSASDA,19.25)
+23 if YSASK'?1N.N
QUIT ""
+24 SET YSASA=YSASA/11
SET YSASB=YSASB/11
SET YSASC=YSASC/11
SET YSASD=YSASD/11
+25 SET YSASE=YSASE/11
SET YSASF=YSASF/11
SET YSASG=YSASG/11
SET YSASH=YSASH/11
+26 SET YSASI=YSASI/330
SET YSASJ=YSASJ/44
SET YSASK=YSASK/44
+27 QUIT YSASA+YSASB+YSASC+YSASD+YSASE+YSASF+YSASG+YSASH+YSASI+YSASJ+YSASK
+28 ;
