YSASCSB ;692/DCL-ASI MISSING COMPOSITE SCORES ;1/23/97 11:39
;;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(YSASDA) ;Entry point
N YSASQUIT,%ZIS,POP
S %ZIS="QM"
D ^%ZIS
Q:$G(POP)
I $D(IO("Q")) D Q
.N ZTRTN,ZTDESC,ZTSAVE
.S ZTRTN="QTEP^YSASCSB"
.S ZTDESC="Display Status of Each Composite Score Item"
.S ZTSAVE("YSASDA")=""
.D ^%ZTLOAD
.D HOME^%ZIS
.Q
U IO
QTEP ;Queued Task Entry Point
D CSMS,CSES,CSA,CSD,EN^YSASCSC
;I $E(IOST)="P" W:$D(IOF) @IOF
Q:$$FF
D ^%ZISC
Q
CSMS ;Composit Score for Medical Status
I $E(IOST)="C" W:$D(IOF) @IOF
D HDR
W !!,"Fields for Medical Composite Scores"
W !,"-----------------------------------",!
N YSASA,YSASB,YSASC,YSASI
S YSASA=$$IF(YSASDA,8.08)
W !,$$C(YSASA,"M6")
S YSASB=$$IF(YSASDA,8.09)
W !,$$C(YSASB,"M7")
S YSASC=$$IF(YSASDA,8.11)
W !,$$C(YSASC,"M8")
I YSASA=""!(YSASB="")!(YSASC="") W !!,$$EM("Medical") Q
W !!,$$SM("Medical"),$J((YSASA/90)+(YSASB/12)+(YSASC/12),6,4)
Q
;
CSES ;Composit Score for Employment Status
W !!!,"Items for Employment Composite Scores"
W !,"-------------------------------------",!
N YSASA,YSASB,YSASC,YSASD,YSASI
S YSASA=$$IF(YSASDA,9.06,"I")
W !,$$C(YSASA,"E4")
S YSASB=$$IF(YSASDA,9.09,"I")
W !,$$C(YSASB,"E5")
S YSASC=$$IF(YSASDA,9.18)
W !,$$C(YSASC,"E11")
S YSASD=$$IF(YSASDA,9.19)
W !,$$C(YSASD,"E12")
I YSASA=""!(YSASB="")!(YSASC="")!(YSASD="") W !!,$$EM("Employment") Q
S:YSASD>0 YSASD=$$LN^XLFMTH(YSASD)
S YSASA=YSASA/4,YSASB=YSASB/4,YSASC=YSASC/120,YSASD=YSASD/36
W !!,$$SM("Employment"),$J(1.000-(YSASA+YSASB+YSASC+YSASD),6,4)
Q
;
CSA ;Composit Score for Alcohol
Q:$$FF
D:$E(IOST)="C" HDR
W !!!,"Items for Alcohol Composite Scores"
W !,"----------------------------------",!
N YSASA,YSASB,YSASC,YSASD,YSASE,YSASF
S YSASA=$$IF(YSASDA,10.01)
W !,$$C(YSASA,"D1")
S YSASB=$$IF(YSASDA,10.04)
W !,$$C(YSASB,"D2")
S YSASC=$$IF(YSASDA,11.14)
W !,$$C(YSASC,"D26")
S YSASD=$$IF(YSASDA,11.16)
W !,$$C(YSASD,"D28")
S YSASE=$$IF(YSASDA,11.165)
W !,$$C(YSASE,"D30")
S YSASF=$$IF(YSASDA,11.09)
W !,$$C(YSASF,"D23")
I YSASA=""!(YSASB="")!(YSASC="")!(YSASD="")!(YSASE="")!(YSASF="") W !!,$$EM("Alcohol") Q
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
W !!,$$SM("Alcohol"),$J(YSASA+YSASB+YSASC+YSASD+YSASE+YSASF,6,4)
Q
;
CSD ;Composit Score for Drug
Q:$$FF
D:$E(IOST)="C" HDR
W !!!,"Items for Drug Composite Scores"
W !,"-------------------------------",!
N YSASA,YSASB,YSASC,YSASD,YSASE,YSASF,YSASG,YSASH,YSASI,YSASJ,YSASK,YSASL,YSASM
S YSASA=$$IF(YSASDA,10.07)
W !,$$C(YSASA,"D3")
S YSASB=$$IF(YSASDA,10.11)
W !,$$C(YSASB,"D4")
S YSASC=$$IF(YSASDA,10.15)
W !,$$C(YSASC,"D5")
S YSASD=$$IF(YSASDA,10.18)
W !,$$C(YSASD,"D6")
S YSASE=$$IF(YSASDA,10.22)
W !,$$C(YSASE,"D7")
S YSASF=$$IF(YSASDA,10.25)
W !,$$C(YSASF,"D8")
S YSASG=$$IF(YSASDA,10.28)
W !,$$C(YSASG,"D9")
S YSASH=$$IF(YSASDA,10.32)
W !,$$C(YSASH,"D10")
S YSASI=$$IF(YSASDA,10.35)
W !,$$C(YSASI,"D11")
S YSASJ=$$IF(YSASDA,10.42)
W !,$$C(YSASJ,"D13")
S YSASK=$$IF(YSASDA,11.15)
W !,$$C(YSASK,"D27")
S YSASL=$$IF(YSASDA,11.17)
W !,$$C(YSASL,"D29")
S YSASM=$$IF(YSASDA,11.175)
W !,$$C(YSASM,"D31")
I YSASA=""!(YSASB="")!(YSASC="")!(YSASD="")!(YSASE="")!(YSASF="")!(YSASG="")!(YSASH="")!(YSASI="")!(YSASJ="")!(YSASK="")!(YSASL="")!(YSASM="") W !!,$$EM("Drug") Q
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
W !!,$$SM("Drug"),$J(YSASA+YSASB+YSASC+YSASD+YSASE+YSASF+YSASG+YSASH+YSASI+YSASJ+YSASK+YSASL+YSASM,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 interview date: ",$$IF(YSASDA,.05)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSASCSB 4616 printed Dec 13, 2024@02:13:02 Page 2
YSASCSB ;692/DCL-ASI MISSING COMPOSITE SCORES ;1/23/97 11:39
+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(YSASDA) ;Entry point
+1 NEW YSASQUIT,%ZIS,POP
+2 SET %ZIS="QM"
+3 DO ^%ZIS
+4 if $GET(POP)
QUIT
+5 IF $DATA(IO("Q"))
Begin DoDot:1
+6 NEW ZTRTN,ZTDESC,ZTSAVE
+7 SET ZTRTN="QTEP^YSASCSB"
+8 SET ZTDESC="Display Status of Each Composite Score Item"
+9 SET ZTSAVE("YSASDA")=""
+10 DO ^%ZTLOAD
+11 DO HOME^%ZIS
+12 QUIT
End DoDot:1
QUIT
+13 USE IO
QTEP ;Queued Task Entry Point
+1 DO CSMS
DO CSES
DO CSA
DO CSD
DO EN^YSASCSC
+2 ;I $E(IOST)="P" W:$D(IOF) @IOF
+3 if $$FF
QUIT
+4 DO ^%ZISC
+5 QUIT
CSMS ;Composit Score for Medical Status
+1 IF $EXTRACT(IOST)="C"
if $DATA(IOF)
WRITE @IOF
+2 DO HDR
+3 WRITE !!,"Fields for Medical Composite Scores"
+4 WRITE !,"-----------------------------------",!
+5 NEW YSASA,YSASB,YSASC,YSASI
+6 SET YSASA=$$IF(YSASDA,8.08)
+7 WRITE !,$$C(YSASA,"M6")
+8 SET YSASB=$$IF(YSASDA,8.09)
+9 WRITE !,$$C(YSASB,"M7")
+10 SET YSASC=$$IF(YSASDA,8.11)
+11 WRITE !,$$C(YSASC,"M8")
+12 IF YSASA=""!(YSASB="")!(YSASC="")
WRITE !!,$$EM("Medical")
QUIT
+13 WRITE !!,$$SM("Medical"),$JUSTIFY((YSASA/90)+(YSASB/12)+(YSASC/12),6,4)
+14 QUIT
+15 ;
CSES ;Composit Score for Employment Status
+1 WRITE !!!,"Items for Employment Composite Scores"
+2 WRITE !,"-------------------------------------",!
+3 NEW YSASA,YSASB,YSASC,YSASD,YSASI
+4 SET YSASA=$$IF(YSASDA,9.06,"I")
+5 WRITE !,$$C(YSASA,"E4")
+6 SET YSASB=$$IF(YSASDA,9.09,"I")
+7 WRITE !,$$C(YSASB,"E5")
+8 SET YSASC=$$IF(YSASDA,9.18)
+9 WRITE !,$$C(YSASC,"E11")
+10 SET YSASD=$$IF(YSASDA,9.19)
+11 WRITE !,$$C(YSASD,"E12")
+12 IF YSASA=""!(YSASB="")!(YSASC="")!(YSASD="")
WRITE !!,$$EM("Employment")
QUIT
+13 if YSASD>0
SET YSASD=$$LN^XLFMTH(YSASD)
+14 SET YSASA=YSASA/4
SET YSASB=YSASB/4
SET YSASC=YSASC/120
SET YSASD=YSASD/36
+15 WRITE !!,$$SM("Employment"),$JUSTIFY(1.000-(YSASA+YSASB+YSASC+YSASD),6,4)
+16 QUIT
+17 ;
CSA ;Composit Score for Alcohol
+1 if $$FF
QUIT
+2 if $EXTRACT(IOST)="C"
DO HDR
+3 WRITE !!!,"Items for Alcohol Composite Scores"
+4 WRITE !,"----------------------------------",!
+5 NEW YSASA,YSASB,YSASC,YSASD,YSASE,YSASF
+6 SET YSASA=$$IF(YSASDA,10.01)
+7 WRITE !,$$C(YSASA,"D1")
+8 SET YSASB=$$IF(YSASDA,10.04)
+9 WRITE !,$$C(YSASB,"D2")
+10 SET YSASC=$$IF(YSASDA,11.14)
+11 WRITE !,$$C(YSASC,"D26")
+12 SET YSASD=$$IF(YSASDA,11.16)
+13 WRITE !,$$C(YSASD,"D28")
+14 SET YSASE=$$IF(YSASDA,11.165)
+15 WRITE !,$$C(YSASE,"D30")
+16 SET YSASF=$$IF(YSASDA,11.09)
+17 WRITE !,$$C(YSASF,"D23")
+18 IF YSASA=""!(YSASB="")!(YSASC="")!(YSASD="")!(YSASE="")!(YSASF="")
WRITE !!,$$EM("Alcohol")
QUIT
+19 if YSASF>0
SET YSASF=$$LN^XLFMTH(YSASF)
+20 SET YSASA=YSASA/180
SET YSASB=YSASB/180
SET YSASC=YSASC/180
SET YSASD=YSASD/24
+21 SET YSASE=YSASE/24
SET YSASF=YSASF/44
+22 WRITE !!,$$SM("Alcohol"),$JUSTIFY(YSASA+YSASB+YSASC+YSASD+YSASE+YSASF,6,4)
+23 QUIT
+24 ;
CSD ;Composit Score for Drug
+1 if $$FF
QUIT
+2 if $EXTRACT(IOST)="C"
DO HDR
+3 WRITE !!!,"Items for Drug Composite Scores"
+4 WRITE !,"-------------------------------",!
+5 NEW YSASA,YSASB,YSASC,YSASD,YSASE,YSASF,YSASG,YSASH,YSASI,YSASJ,YSASK,YSASL,YSASM
+6 SET YSASA=$$IF(YSASDA,10.07)
+7 WRITE !,$$C(YSASA,"D3")
+8 SET YSASB=$$IF(YSASDA,10.11)
+9 WRITE !,$$C(YSASB,"D4")
+10 SET YSASC=$$IF(YSASDA,10.15)
+11 WRITE !,$$C(YSASC,"D5")
+12 SET YSASD=$$IF(YSASDA,10.18)
+13 WRITE !,$$C(YSASD,"D6")
+14 SET YSASE=$$IF(YSASDA,10.22)
+15 WRITE !,$$C(YSASE,"D7")
+16 SET YSASF=$$IF(YSASDA,10.25)
+17 WRITE !,$$C(YSASF,"D8")
+18 SET YSASG=$$IF(YSASDA,10.28)
+19 WRITE !,$$C(YSASG,"D9")
+20 SET YSASH=$$IF(YSASDA,10.32)
+21 WRITE !,$$C(YSASH,"D10")
+22 SET YSASI=$$IF(YSASDA,10.35)
+23 WRITE !,$$C(YSASI,"D11")
+24 SET YSASJ=$$IF(YSASDA,10.42)
+25 WRITE !,$$C(YSASJ,"D13")
+26 SET YSASK=$$IF(YSASDA,11.15)
+27 WRITE !,$$C(YSASK,"D27")
+28 SET YSASL=$$IF(YSASDA,11.17)
+29 WRITE !,$$C(YSASL,"D29")
+30 SET YSASM=$$IF(YSASDA,11.175)
+31 WRITE !,$$C(YSASM,"D31")
+32 IF YSASA=""!(YSASB="")!(YSASC="")!(YSASD="")!(YSASE="")!(YSASF="")!(YSASG="")!(YSASH="")!(YSASI="")!(YSASJ="")!(YSASK="")!(YSASL="")!(YSASM="")
WRITE !!,$$EM("Drug")
QUIT
+33 SET YSASA=YSASA/390
SET YSASB=YSASB/390
SET YSASC=YSASC/390
SET YSASD=YSASD/390
+34 SET YSASE=YSASE/390
SET YSASF=YSASF/390
SET YSASG=YSASG/390
SET YSASH=YSASH/390
+35 SET YSASI=YSASI/390
SET YSASJ=YSASJ/390
SET YSASK=YSASK/390
SET YSASL=YSASL/52
+36 SET YSASM=YSASM/52
+37 WRITE !!,$$SM("Drug"),$JUSTIFY(YSASA+YSASB+YSASC+YSASD+YSASE+YSASF+YSASG+YSASH+YSASI+YSASJ+YSASK+YSASL+YSASM,6,4)
+38 QUIT
+39 ;
+40 ;
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 interview date: ",$$IF(YSASDA,.05)
+2 QUIT
