source: FOIAVistA/tag/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSASCSB.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.4 KB
Line 
1YSASCSB ;692/DCL-ASI MISSING COMPOSITE SCORES ;1/23/97 11:39
2 ;;5.01;MENTAL HEALTH;**24**;Dec 30, 1994
3 Q
4 ;
5IF(YSASIEN,YSASFLD,YSASFLG) ;pass ien and field - return content
6 Q:$G(YSASIEN)'>0 ""
7 Q:$G(YSASFLD)'>0 ""
8 N DIERR
9 Q $$GET1^DIQ(604,YSASIEN_",",YSASFLD,$G(YSASFLG))
10 ;
11C(X,Y,Z) ;return score/msg - pass data in X, Item # in Y and optional comment in Z.
12 I $G(X)="" Q " Item "_Y_$J("",(4-$L(Y)))_" <missing data> "_$G(Z)
13 Q " Item "_Y_$J("",(4-$L(Y)))_$J(X,6)_" ..ok "_$G(Z)
14 ;
15EM(X) ;Error Message
16 Q:$G(X)="" ""
17 Q "No Composite Score"
18 ;
19SM(X) ;Score Message
20 Q:$G(X)="" ""
21 Q "Composite Score: "
22 ;
23EN(YSASDA) ;Entry point
24 N YSASQUIT,%ZIS,POP
25 S %ZIS="QM"
26 D ^%ZIS
27 Q:$G(POP)
28 I $D(IO("Q")) D Q
29 .N ZTRTN,ZTDESC,ZTSAVE
30 .S ZTRTN="QTEP^YSASCSB"
31 .S ZTDESC="Display Status of Each Composite Score Item"
32 .S ZTSAVE("YSASDA")=""
33 .D ^%ZTLOAD
34 .D HOME^%ZIS
35 .Q
36 U IO
37QTEP ;Queued Task Entry Point
38 D CSMS,CSES,CSA,CSD,EN^YSASCSC
39 ;I $E(IOST)="P" W:$D(IOF) @IOF
40 Q:$$FF
41 D ^%ZISC
42 Q
43CSMS ;Composit Score for Medical Status
44 I $E(IOST)="C" W:$D(IOF) @IOF
45 D HDR
46 W !!,"Fields for Medical Composite Scores"
47 W !,"-----------------------------------",!
48 N YSASA,YSASB,YSASC,YSASI
49 S YSASA=$$IF(YSASDA,8.08)
50 W !,$$C(YSASA,"M6")
51 S YSASB=$$IF(YSASDA,8.09)
52 W !,$$C(YSASB,"M7")
53 S YSASC=$$IF(YSASDA,8.11)
54 W !,$$C(YSASC,"M8")
55 I YSASA=""!(YSASB="")!(YSASC="") W !!,$$EM("Medical") Q
56 W !!,$$SM("Medical"),$J((YSASA/90)+(YSASB/12)+(YSASC/12),6,4)
57 Q
58 ;
59CSES ;Composit Score for Employment Status
60 W !!!,"Items for Employment Composite Scores"
61 W !,"-------------------------------------",!
62 N YSASA,YSASB,YSASC,YSASD,YSASI
63 S YSASA=$$IF(YSASDA,9.06,"I")
64 W !,$$C(YSASA,"E4")
65 S YSASB=$$IF(YSASDA,9.09,"I")
66 W !,$$C(YSASB,"E5")
67 S YSASC=$$IF(YSASDA,9.18)
68 W !,$$C(YSASC,"E11")
69 S YSASD=$$IF(YSASDA,9.19)
70 W !,$$C(YSASD,"E12")
71 I YSASA=""!(YSASB="")!(YSASC="")!(YSASD="") W !!,$$EM("Employment") Q
72 S:YSASD>0 YSASD=$$LN^XLFMTH(YSASD)
73 S YSASA=YSASA/4,YSASB=YSASB/4,YSASC=YSASC/120,YSASD=YSASD/36
74 W !!,$$SM("Employment"),$J(1.000-(YSASA+YSASB+YSASC+YSASD),6,4)
75 Q
76 ;
77CSA ;Composit Score for Alcohol
78 Q:$$FF
79 D:$E(IOST)="C" HDR
80 W !!!,"Items for Alcohol Composite Scores"
81 W !,"----------------------------------",!
82 N YSASA,YSASB,YSASC,YSASD,YSASE,YSASF
83 S YSASA=$$IF(YSASDA,10.01)
84 W !,$$C(YSASA,"D1")
85 S YSASB=$$IF(YSASDA,10.04)
86 W !,$$C(YSASB,"D2")
87 S YSASC=$$IF(YSASDA,11.14)
88 W !,$$C(YSASC,"D26")
89 S YSASD=$$IF(YSASDA,11.16)
90 W !,$$C(YSASD,"D28")
91 S YSASE=$$IF(YSASDA,11.165)
92 W !,$$C(YSASE,"D30")
93 S YSASF=$$IF(YSASDA,11.09)
94 W !,$$C(YSASF,"D23")
95 I YSASA=""!(YSASB="")!(YSASC="")!(YSASD="")!(YSASE="")!(YSASF="") W !!,$$EM("Alcohol") Q
96 S:YSASF>0 YSASF=$$LN^XLFMTH(YSASF)
97 S YSASA=YSASA/180,YSASB=YSASB/180,YSASC=YSASC/180,YSASD=YSASD/24
98 S YSASE=YSASE/24,YSASF=YSASF/44
99 W !!,$$SM("Alcohol"),$J(YSASA+YSASB+YSASC+YSASD+YSASE+YSASF,6,4)
100 Q
101 ;
102CSD ;Composit Score for Drug
103 Q:$$FF
104 D:$E(IOST)="C" HDR
105 W !!!,"Items for Drug Composite Scores"
106 W !,"-------------------------------",!
107 N YSASA,YSASB,YSASC,YSASD,YSASE,YSASF,YSASG,YSASH,YSASI,YSASJ,YSASK,YSASL,YSASM
108 S YSASA=$$IF(YSASDA,10.07)
109 W !,$$C(YSASA,"D3")
110 S YSASB=$$IF(YSASDA,10.11)
111 W !,$$C(YSASB,"D4")
112 S YSASC=$$IF(YSASDA,10.15)
113 W !,$$C(YSASC,"D5")
114 S YSASD=$$IF(YSASDA,10.18)
115 W !,$$C(YSASD,"D6")
116 S YSASE=$$IF(YSASDA,10.22)
117 W !,$$C(YSASE,"D7")
118 S YSASF=$$IF(YSASDA,10.25)
119 W !,$$C(YSASF,"D8")
120 S YSASG=$$IF(YSASDA,10.28)
121 W !,$$C(YSASG,"D9")
122 S YSASH=$$IF(YSASDA,10.32)
123 W !,$$C(YSASH,"D10")
124 S YSASI=$$IF(YSASDA,10.35)
125 W !,$$C(YSASI,"D11")
126 S YSASJ=$$IF(YSASDA,10.42)
127 W !,$$C(YSASJ,"D13")
128 S YSASK=$$IF(YSASDA,11.15)
129 W !,$$C(YSASK,"D27")
130 S YSASL=$$IF(YSASDA,11.17)
131 W !,$$C(YSASL,"D29")
132 S YSASM=$$IF(YSASDA,11.175)
133 W !,$$C(YSASM,"D31")
134 I YSASA=""!(YSASB="")!(YSASC="")!(YSASD="")!(YSASE="")!(YSASF="")!(YSASG="")!(YSASH="")!(YSASI="")!(YSASJ="")!(YSASK="")!(YSASL="")!(YSASM="") W !!,$$EM("Drug") Q
135 S YSASA=YSASA/390,YSASB=YSASB/390,YSASC=YSASC/390,YSASD=YSASD/390
136 S YSASE=YSASE/390,YSASF=YSASF/390,YSASG=YSASG/390,YSASH=YSASH/390
137 S YSASI=YSASI/390,YSASJ=YSASJ/390,YSASK=YSASK/390,YSASL=YSASL/52
138 S YSASM=YSASM/52
139 W !!,$$SM("Drug"),$J(YSASA+YSASB+YSASC+YSASD+YSASE+YSASF+YSASG+YSASH+YSASI+YSASJ+YSASK+YSASL+YSASM,6,4)
140 Q
141 ;
142 ;
143FF() ;Form Feed
144 I $E(IOST)'="C" Q 0
145 I $G(YSASQUIT) Q 1
146 N X
147 W !!,"<press <cr> to continue>"
148 R X:DTIME
149 W:$D(IOF) @IOF
150 I $E(X)="^" S YSASQUIT=1 Q 1
151 Q 0
152 ;
153HDR ;Header
154 W !,$$IF(YSASDA,.02)," ASI interview date: ",$$IF(YSASDA,.05)
155 Q
Note: See TracBrowser for help on using the repository browser.