- 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 Feb 18, 2025@23:39:19 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