YSASCSC ;692/DCL-ASI MISSING COMPOSITE SCORES ;1/23/97 11:41
;;5.01;MENTAL HEALTH;**24**;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))
;
C(X,Y,Z) ;return score/msg - pass data in X, Item # in Y and optional comment in Z.
I $G(X)="" Q " Item "_Y_$J("",(4-$L(Y)))_" <missing data> "_$G(Z)
Q " Item "_Y_$J("",(4-$L(Y)))_$J(X,6)_" ..ok "_$G(Z)
;
EM(X) ;Error Message
Q:$G(X)="" ""
Q "No Composite Score"
;
SM(X) ;Score Message
Q:$G(X)="" ""
Q "Composite Score: "
;
EN ;Entry point continuation from YSASCSB
D CSLS,CSFSR,CSPS
Q
CSLS ;Composite Score for Legal Status
I $E(IOST)="P" W:$D(IOF) @IOF
Q:$$FF
D HDR
W !!!,"Items for Legal Composite Scores"
W !,"--------------------------------",!
N YSASA,YSASB,YSASC,YSASD,YSASE
S YSASA=$$IF(YSASDA,14.27,"I")
W !,$$C(YSASA,"L24")
S YSASB=$$IF(YSASDA,14.31)
W !,$$C(YSASB,"L27")
S YSASC=$$IF(YSASDA,14.32)
W !,$$C(YSASC,"L28")
S YSASD=$$IF(YSASDA,14.33)
W !,$$C(YSASD,"L29")
S YSASE=$$IF(YSASDA,9.25)
W !,$$C(YSASE,"E17","<Item 17 from Employment Domain>")
I YSASA=""!(YSASB="")!(YSASC="")!(YSASD="")!(YSASE="") W !!,$$EM("Legal") Q
S:YSASE>0 YSASE=$$LN^XLFMTH(YSASE)
S YSASA=YSASA/5,YSASB=YSASB/150,YSASC=YSASC/20,YSASD=YSASD/20
S YSASE=YSASE/46
W !!,$$SM("Legal"),$J(YSASA+YSASB+YSASC+YSASD+YSASE,6,4)
Q
;
CSFSR ;Composite Score for Family/Social Relationships
Q:$$FF
D:$E(IOST)="C" HDR
W !!!,"Items for Family/Social Composite Scores"
W !,"----------------------------------------",!
N YSASA,YSASB,YSASC,YSASD,YSASR
S YSASA=$$IF(YSASDA,17.04)
S:YSASA]"" YSASA=$S(YSASA="YES":0,YSASA="NO":2,1:1)
W !,$$C(YSASA,"F3")
S YSASB=$$IF(YSASDA,18.23)
W !,$$C(YSASB,"F30")
S YSASC=$$IF(YSASDA,18.25)
W !,$$C(YSASC,"F32")
S YSASD=$$IF(YSASDA,18.27)
W !,$$C(YSASD,"F34")
D
.N YSASI,YSASX
.S YSASR=0
.S YSASF=".01,.03,.05,.07,.09,.12,.15,.17,.185"
.S YSASI="10,11,12,13,14,15,16,17,18"
.F YSASC=1:1:9 D
..S YSASX=$$IF(YSASDA,18_$P(YSASF,",",YSASC),"I")
..W !,$$C(YSASX,"F"_(YSASC+17))
..S:YSASX="" YSASR=""
..Q:YSASR=""
..S YSASR=YSASR+YSASX
..Q
.Q:YSASR=""
.S YSASR=YSASR/9
.Q
I YSASA=""!(YSASB="")!(YSASC="")!(YSASD="")!(YSASR="") W !!,$$EM("Family/Social") Q
S YSASA=YSASA/10,YSASB=YSASB/150,YSASC=YSASC/20,YSASD=YSASD/20
S YSASR=YSASR/5
W !!,$$SM("Family/Social"),$J(YSASA+YSASB+YSASC+YSASD+YSASR,6,4)
Q
;
CSPS ;Composite Score for Psychiatric Status
Q:$$FF
D:$E(IOST)="C" HDR
W !!!,"Items for Psychiatric Composite Scores"
W !,"--------------------------------------",!
N YSASA,YSASB,YSASC,YSASD,YSASE,YSASF,YSASG,YSASH,YSASI,YSASJ,YSASK
S YSASA=$$IF(YSASDA,19.04,"I")
W !,$$C(YSASA,"P3")
S YSASB=$$IF(YSASDA,19.06,"I")
W !,$$C(YSASB,"P4")
S YSASC=$$IF(YSASDA,19.08,"I")
W !,$$C(YSASC,"P5")
S YSASD=$$IF(YSASDA,19.11,"I")
W !,$$C(YSASD,"P6")
S YSASE=$$IF(YSASDA,19.14,"I")
W !,$$C(YSASE,"P7")
S YSASF=$$IF(YSASDA,19.16,"I")
W !,$$C(YSASF,"P8")
S YSASG=$$IF(YSASDA,19.18,"I")
W !,$$C(YSASG,"P9")
S YSASH=$$IF(YSASDA,19.21,"I")
W !,$$C(YSASH,"P10")
S YSASI=$$IF(YSASDA,19.23)
W !,$$C(YSASI,"P11")
S YSASJ=$$IF(YSASDA,19.24)
W !,$$C(YSASJ,"P12")
S YSASK=$$IF(YSASDA,19.25)
W !,$$C(YSASK,"P13")
I YSASA=""!(YSASB="")!(YSASC="")!(YSASD="")!(YSASE="")!(YSASF="")!(YSASG="")!(YSASH="")!(YSASI="")!(YSASJ="")!(YSASK="") W !!,$$EM("Paychiatric") Q
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
W !!,$$SM("Psychiatric"),$J(YSASA+YSASB+YSASC+YSASD+YSASE+YSASF+YSASG+YSASH+YSASI+YSASJ+YSASK,6,4)
Q
;
FF() ;Form Feed
I $E(IOST)'="C" Q 0
I $G(YSASQUIT) Q 1
N X
W !!,"<press <cr> to continue>"
R X:DTIME
W:$D(IOF) @IOF
I $E(X)="^" S YSASQUIT=1 Q 1
Q 0
;
HDR ;Header
W !,$$IF(YSASDA,.02)," ASI date of interview: ",$$IF(YSASDA,.05)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSASCSC 4079 printed Sep 23, 2025@19:49:08 Page 2
YSASCSC ;692/DCL-ASI MISSING COMPOSITE SCORES ;1/23/97 11:41
+1 ;;5.01;MENTAL HEALTH;**24**;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 ;
C(X,Y,Z) ;return score/msg - pass data in X, Item # in Y and optional comment in Z.
+1 IF $GET(X)=""
QUIT " Item "_Y_$JUSTIFY("",(4-$LENGTH(Y)))_" <missing data> "_$GET(Z)
+2 QUIT " Item "_Y_$JUSTIFY("",(4-$LENGTH(Y)))_$JUSTIFY(X,6)_" ..ok "_$GET(Z)
+3 ;
EM(X) ;Error Message
+1 if $GET(X)=""
QUIT ""
+2 QUIT "No Composite Score"
+3 ;
SM(X) ;Score Message
+1 if $GET(X)=""
QUIT ""
+2 QUIT "Composite Score: "
+3 ;
EN ;Entry point continuation from YSASCSB
+1 DO CSLS
DO CSFSR
DO CSPS
+2 QUIT
CSLS ;Composite Score for Legal Status
+1 IF $EXTRACT(IOST)="P"
if $DATA(IOF)
WRITE @IOF
+2 if $$FF
QUIT
+3 DO HDR
+4 WRITE !!!,"Items for Legal Composite Scores"
+5 WRITE !,"--------------------------------",!
+6 NEW YSASA,YSASB,YSASC,YSASD,YSASE
+7 SET YSASA=$$IF(YSASDA,14.27,"I")
+8 WRITE !,$$C(YSASA,"L24")
+9 SET YSASB=$$IF(YSASDA,14.31)
+10 WRITE !,$$C(YSASB,"L27")
+11 SET YSASC=$$IF(YSASDA,14.32)
+12 WRITE !,$$C(YSASC,"L28")
+13 SET YSASD=$$IF(YSASDA,14.33)
+14 WRITE !,$$C(YSASD,"L29")
+15 SET YSASE=$$IF(YSASDA,9.25)
+16 WRITE !,$$C(YSASE,"E17","<Item 17 from Employment Domain>")
+17 IF YSASA=""!(YSASB="")!(YSASC="")!(YSASD="")!(YSASE="")
WRITE !!,$$EM("Legal")
QUIT
+18 if YSASE>0
SET YSASE=$$LN^XLFMTH(YSASE)
+19 SET YSASA=YSASA/5
SET YSASB=YSASB/150
SET YSASC=YSASC/20
SET YSASD=YSASD/20
+20 SET YSASE=YSASE/46
+21 WRITE !!,$$SM("Legal"),$JUSTIFY(YSASA+YSASB+YSASC+YSASD+YSASE,6,4)
+22 QUIT
+23 ;
CSFSR ;Composite Score for Family/Social Relationships
+1 if $$FF
QUIT
+2 if $EXTRACT(IOST)="C"
DO HDR
+3 WRITE !!!,"Items for Family/Social Composite Scores"
+4 WRITE !,"----------------------------------------",!
+5 NEW YSASA,YSASB,YSASC,YSASD,YSASR
+6 SET YSASA=$$IF(YSASDA,17.04)
+7 if YSASA]""
SET YSASA=$SELECT(YSASA="YES":0,YSASA="NO":2,1:1)
+8 WRITE !,$$C(YSASA,"F3")
+9 SET YSASB=$$IF(YSASDA,18.23)
+10 WRITE !,$$C(YSASB,"F30")
+11 SET YSASC=$$IF(YSASDA,18.25)
+12 WRITE !,$$C(YSASC,"F32")
+13 SET YSASD=$$IF(YSASDA,18.27)
+14 WRITE !,$$C(YSASD,"F34")
+15 Begin DoDot:1
+16 NEW YSASI,YSASX
+17 SET YSASR=0
+18 SET YSASF=".01,.03,.05,.07,.09,.12,.15,.17,.185"
+19 SET YSASI="10,11,12,13,14,15,16,17,18"
+20 FOR YSASC=1:1:9
Begin DoDot:2
+21 SET YSASX=$$IF(YSASDA,18_$PIECE(YSASF,",",YSASC),"I")
+22 WRITE !,$$C(YSASX,"F"_(YSASC+17))
+23 if YSASX=""
SET YSASR=""
+24 if YSASR=""
QUIT
+25 SET YSASR=YSASR+YSASX
+26 QUIT
End DoDot:2
+27 if YSASR=""
QUIT
+28 SET YSASR=YSASR/9
+29 QUIT
End DoDot:1
+30 IF YSASA=""!(YSASB="")!(YSASC="")!(YSASD="")!(YSASR="")
WRITE !!,$$EM("Family/Social")
QUIT
+31 SET YSASA=YSASA/10
SET YSASB=YSASB/150
SET YSASC=YSASC/20
SET YSASD=YSASD/20
+32 SET YSASR=YSASR/5
+33 WRITE !!,$$SM("Family/Social"),$JUSTIFY(YSASA+YSASB+YSASC+YSASD+YSASR,6,4)
+34 QUIT
+35 ;
CSPS ;Composite Score for Psychiatric Status
+1 if $$FF
QUIT
+2 if $EXTRACT(IOST)="C"
DO HDR
+3 WRITE !!!,"Items for Psychiatric Composite Scores"
+4 WRITE !,"--------------------------------------",!
+5 NEW YSASA,YSASB,YSASC,YSASD,YSASE,YSASF,YSASG,YSASH,YSASI,YSASJ,YSASK
+6 SET YSASA=$$IF(YSASDA,19.04,"I")
+7 WRITE !,$$C(YSASA,"P3")
+8 SET YSASB=$$IF(YSASDA,19.06,"I")
+9 WRITE !,$$C(YSASB,"P4")
+10 SET YSASC=$$IF(YSASDA,19.08,"I")
+11 WRITE !,$$C(YSASC,"P5")
+12 SET YSASD=$$IF(YSASDA,19.11,"I")
+13 WRITE !,$$C(YSASD,"P6")
+14 SET YSASE=$$IF(YSASDA,19.14,"I")
+15 WRITE !,$$C(YSASE,"P7")
+16 SET YSASF=$$IF(YSASDA,19.16,"I")
+17 WRITE !,$$C(YSASF,"P8")
+18 SET YSASG=$$IF(YSASDA,19.18,"I")
+19 WRITE !,$$C(YSASG,"P9")
+20 SET YSASH=$$IF(YSASDA,19.21,"I")
+21 WRITE !,$$C(YSASH,"P10")
+22 SET YSASI=$$IF(YSASDA,19.23)
+23 WRITE !,$$C(YSASI,"P11")
+24 SET YSASJ=$$IF(YSASDA,19.24)
+25 WRITE !,$$C(YSASJ,"P12")
+26 SET YSASK=$$IF(YSASDA,19.25)
+27 WRITE !,$$C(YSASK,"P13")
+28 IF YSASA=""!(YSASB="")!(YSASC="")!(YSASD="")!(YSASE="")!(YSASF="")!(YSASG="")!(YSASH="")!(YSASI="")!(YSASJ="")!(YSASK="")
WRITE !!,$$EM("Paychiatric")
QUIT
+29 SET YSASA=YSASA/11
SET YSASB=YSASB/11
SET YSASC=YSASC/11
SET YSASD=YSASD/11
+30 SET YSASE=YSASE/11
SET YSASF=YSASF/11
SET YSASG=YSASG/11
SET YSASH=YSASH/11
+31 SET YSASI=YSASI/330
SET YSASJ=YSASJ/44
SET YSASK=YSASK/44
+32 WRITE !!,$$SM("Psychiatric"),$JUSTIFY(YSASA+YSASB+YSASC+YSASD+YSASE+YSASF+YSASG+YSASH+YSASI+YSASJ+YSASK,6,4)
+33 QUIT
+34 ;
FF() ;Form Feed
+1 IF $EXTRACT(IOST)'="C"
QUIT 0
+2 IF $GET(YSASQUIT)
QUIT 1
+3 NEW X
+4 WRITE !!,"<press <cr> to continue>"
+5 READ X:DTIME
+6 if $DATA(IOF)
WRITE @IOF
+7 IF $EXTRACT(X)="^"
SET YSASQUIT=1
QUIT 1
+8 QUIT 0
+9 ;
HDR ;Header
+1 WRITE !,$$IF(YSASDA,.02)," ASI date of interview: ",$$IF(YSASDA,.05)
+2 QUIT
