Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: YSASCSB

YSASCSB.m

Go to the documentation of this file.
  1. YSASCSB ;692/DCL-ASI MISSING COMPOSITE SCORES ;1/23/97 11:39
  1. ;;5.01;MENTAL HEALTH;**24**;Dec 30, 1994
  1. Q
  1. ;
  1. IF(YSASIEN,YSASFLD,YSASFLG) ;pass ien and field - return content
  1. Q:$G(YSASIEN)'>0 ""
  1. Q:$G(YSASFLD)'>0 ""
  1. N DIERR
  1. Q $$GET1^DIQ(604,YSASIEN_",",YSASFLD,$G(YSASFLG))
  1. ;
  1. C(X,Y,Z) ;return score/msg - pass data in X, Item # in Y and optional comment in Z.
  1. I $G(X)="" Q " Item "_Y_$J("",(4-$L(Y)))_" <missing data> "_$G(Z)
  1. Q " Item "_Y_$J("",(4-$L(Y)))_$J(X,6)_" ..ok "_$G(Z)
  1. ;
  1. EM(X) ;Error Message
  1. Q:$G(X)="" ""
  1. Q "No Composite Score"
  1. ;
  1. SM(X) ;Score Message
  1. Q:$G(X)="" ""
  1. Q "Composite Score: "
  1. ;
  1. EN(YSASDA) ;Entry point
  1. N YSASQUIT,%ZIS,POP
  1. S %ZIS="QM"
  1. D ^%ZIS
  1. Q:$G(POP)
  1. I $D(IO("Q")) D Q
  1. .N ZTRTN,ZTDESC,ZTSAVE
  1. .S ZTRTN="QTEP^YSASCSB"
  1. .S ZTDESC="Display Status of Each Composite Score Item"
  1. .S ZTSAVE("YSASDA")=""
  1. .D ^%ZTLOAD
  1. .D HOME^%ZIS
  1. .Q
  1. U IO
  1. QTEP ;Queued Task Entry Point
  1. D CSMS,CSES,CSA,CSD,EN^YSASCSC
  1. ;I $E(IOST)="P" W:$D(IOF) @IOF
  1. Q:$$FF
  1. D ^%ZISC
  1. Q
  1. CSMS ;Composit Score for Medical Status
  1. I $E(IOST)="C" W:$D(IOF) @IOF
  1. D HDR
  1. W !!,"Fields for Medical Composite Scores"
  1. W !,"-----------------------------------",!
  1. N YSASA,YSASB,YSASC,YSASI
  1. S YSASA=$$IF(YSASDA,8.08)
  1. W !,$$C(YSASA,"M6")
  1. S YSASB=$$IF(YSASDA,8.09)
  1. W !,$$C(YSASB,"M7")
  1. S YSASC=$$IF(YSASDA,8.11)
  1. W !,$$C(YSASC,"M8")
  1. I YSASA=""!(YSASB="")!(YSASC="") W !!,$$EM("Medical") Q
  1. W !!,$$SM("Medical"),$J((YSASA/90)+(YSASB/12)+(YSASC/12),6,4)
  1. Q
  1. ;
  1. CSES ;Composit Score for Employment Status
  1. W !!!,"Items for Employment Composite Scores"
  1. W !,"-------------------------------------",!
  1. N YSASA,YSASB,YSASC,YSASD,YSASI
  1. S YSASA=$$IF(YSASDA,9.06,"I")
  1. W !,$$C(YSASA,"E4")
  1. S YSASB=$$IF(YSASDA,9.09,"I")
  1. W !,$$C(YSASB,"E5")
  1. S YSASC=$$IF(YSASDA,9.18)
  1. W !,$$C(YSASC,"E11")
  1. S YSASD=$$IF(YSASDA,9.19)
  1. W !,$$C(YSASD,"E12")
  1. I YSASA=""!(YSASB="")!(YSASC="")!(YSASD="") W !!,$$EM("Employment") Q
  1. S:YSASD>0 YSASD=$$LN^XLFMTH(YSASD)
  1. S YSASA=YSASA/4,YSASB=YSASB/4,YSASC=YSASC/120,YSASD=YSASD/36
  1. W !!,$$SM("Employment"),$J(1.000-(YSASA+YSASB+YSASC+YSASD),6,4)
  1. Q
  1. ;
  1. CSA ;Composit Score for Alcohol
  1. Q:$$FF
  1. D:$E(IOST)="C" HDR
  1. W !!!,"Items for Alcohol Composite Scores"
  1. W !,"----------------------------------",!
  1. N YSASA,YSASB,YSASC,YSASD,YSASE,YSASF
  1. S YSASA=$$IF(YSASDA,10.01)
  1. W !,$$C(YSASA,"D1")
  1. S YSASB=$$IF(YSASDA,10.04)
  1. W !,$$C(YSASB,"D2")
  1. S YSASC=$$IF(YSASDA,11.14)
  1. W !,$$C(YSASC,"D26")
  1. S YSASD=$$IF(YSASDA,11.16)
  1. W !,$$C(YSASD,"D28")
  1. S YSASE=$$IF(YSASDA,11.165)
  1. W !,$$C(YSASE,"D30")
  1. S YSASF=$$IF(YSASDA,11.09)
  1. W !,$$C(YSASF,"D23")
  1. I YSASA=""!(YSASB="")!(YSASC="")!(YSASD="")!(YSASE="")!(YSASF="") W !!,$$EM("Alcohol") Q
  1. S:YSASF>0 YSASF=$$LN^XLFMTH(YSASF)
  1. S YSASA=YSASA/180,YSASB=YSASB/180,YSASC=YSASC/180,YSASD=YSASD/24
  1. S YSASE=YSASE/24,YSASF=YSASF/44
  1. W !!,$$SM("Alcohol"),$J(YSASA+YSASB+YSASC+YSASD+YSASE+YSASF,6,4)
  1. Q
  1. ;
  1. CSD ;Composit Score for Drug
  1. Q:$$FF
  1. D:$E(IOST)="C" HDR
  1. W !!!,"Items for Drug Composite Scores"
  1. W !,"-------------------------------",!
  1. N YSASA,YSASB,YSASC,YSASD,YSASE,YSASF,YSASG,YSASH,YSASI,YSASJ,YSASK,YSASL,YSASM
  1. S YSASA=$$IF(YSASDA,10.07)
  1. W !,$$C(YSASA,"D3")
  1. S YSASB=$$IF(YSASDA,10.11)
  1. W !,$$C(YSASB,"D4")
  1. S YSASC=$$IF(YSASDA,10.15)
  1. W !,$$C(YSASC,"D5")
  1. S YSASD=$$IF(YSASDA,10.18)
  1. W !,$$C(YSASD,"D6")
  1. S YSASE=$$IF(YSASDA,10.22)
  1. W !,$$C(YSASE,"D7")
  1. S YSASF=$$IF(YSASDA,10.25)
  1. W !,$$C(YSASF,"D8")
  1. S YSASG=$$IF(YSASDA,10.28)
  1. W !,$$C(YSASG,"D9")
  1. S YSASH=$$IF(YSASDA,10.32)
  1. W !,$$C(YSASH,"D10")
  1. S YSASI=$$IF(YSASDA,10.35)
  1. W !,$$C(YSASI,"D11")
  1. S YSASJ=$$IF(YSASDA,10.42)
  1. W !,$$C(YSASJ,"D13")
  1. S YSASK=$$IF(YSASDA,11.15)
  1. W !,$$C(YSASK,"D27")
  1. S YSASL=$$IF(YSASDA,11.17)
  1. W !,$$C(YSASL,"D29")
  1. S YSASM=$$IF(YSASDA,11.175)
  1. W !,$$C(YSASM,"D31")
  1. I YSASA=""!(YSASB="")!(YSASC="")!(YSASD="")!(YSASE="")!(YSASF="")!(YSASG="")!(YSASH="")!(YSASI="")!(YSASJ="")!(YSASK="")!(YSASL="")!(YSASM="") W !!,$$EM("Drug") Q
  1. S YSASA=YSASA/390,YSASB=YSASB/390,YSASC=YSASC/390,YSASD=YSASD/390
  1. S YSASE=YSASE/390,YSASF=YSASF/390,YSASG=YSASG/390,YSASH=YSASH/390
  1. S YSASI=YSASI/390,YSASJ=YSASJ/390,YSASK=YSASK/390,YSASL=YSASL/52
  1. S YSASM=YSASM/52
  1. W !!,$$SM("Drug"),$J(YSASA+YSASB+YSASC+YSASD+YSASE+YSASF+YSASG+YSASH+YSASI+YSASJ+YSASK+YSASL+YSASM,6,4)
  1. Q
  1. ;
  1. ;
  1. FF() ;Form Feed
  1. I $E(IOST)'="C" Q 0
  1. I $G(YSASQUIT) Q 1
  1. N X
  1. W !!,"<press <cr> to continue>"
  1. R X:DTIME
  1. W:$D(IOF) @IOF
  1. I $E(X)="^" S YSASQUIT=1 Q 1
  1. Q 0
  1. ;
  1. HDR ;Header
  1. W !,$$IF(YSASDA,.02)," ASI interview date: ",$$IF(YSASDA,.05)
  1. Q