source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSASCSC.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1YSASCSC ;692/DCL-ASI MISSING COMPOSITE SCORES ;1/23/97 11:41
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 ;Entry point continuation from YSASCSB
24 D CSLS,CSFSR,CSPS
25 Q
26CSLS ;Composite Score for Legal Status
27 I $E(IOST)="P" W:$D(IOF) @IOF
28 Q:$$FF
29 D HDR
30 W !!!,"Items for Legal Composite Scores"
31 W !,"--------------------------------",!
32 N YSASA,YSASB,YSASC,YSASD,YSASE
33 S YSASA=$$IF(YSASDA,14.27,"I")
34 W !,$$C(YSASA,"L24")
35 S YSASB=$$IF(YSASDA,14.31)
36 W !,$$C(YSASB,"L27")
37 S YSASC=$$IF(YSASDA,14.32)
38 W !,$$C(YSASC,"L28")
39 S YSASD=$$IF(YSASDA,14.33)
40 W !,$$C(YSASD,"L29")
41 S YSASE=$$IF(YSASDA,9.25)
42 W !,$$C(YSASE,"E17","<Item 17 from Employment Domain>")
43 I YSASA=""!(YSASB="")!(YSASC="")!(YSASD="")!(YSASE="") W !!,$$EM("Legal") Q
44 S:YSASE>0 YSASE=$$LN^XLFMTH(YSASE)
45 S YSASA=YSASA/5,YSASB=YSASB/150,YSASC=YSASC/20,YSASD=YSASD/20
46 S YSASE=YSASE/46
47 W !!,$$SM("Legal"),$J(YSASA+YSASB+YSASC+YSASD+YSASE,6,4)
48 Q
49 ;
50CSFSR ;Composite Score for Family/Social Relationships
51 Q:$$FF
52 D:$E(IOST)="C" HDR
53 W !!!,"Items for Family/Social Composite Scores"
54 W !,"----------------------------------------",!
55 N YSASA,YSASB,YSASC,YSASD,YSASR
56 S YSASA=$$IF(YSASDA,17.04)
57 S:YSASA]"" YSASA=$S(YSASA="YES":0,YSASA="NO":2,1:1)
58 W !,$$C(YSASA,"F3")
59 S YSASB=$$IF(YSASDA,18.23)
60 W !,$$C(YSASB,"F30")
61 S YSASC=$$IF(YSASDA,18.25)
62 W !,$$C(YSASC,"F32")
63 S YSASD=$$IF(YSASDA,18.27)
64 W !,$$C(YSASD,"F34")
65 D
66 .N YSASI,YSASX
67 .S YSASR=0
68 .S YSASF=".01,.03,.05,.07,.09,.12,.15,.17,.185"
69 .S YSASI="10,11,12,13,14,15,16,17,18"
70 .F YSASC=1:1:9 D
71 ..S YSASX=$$IF(YSASDA,18_$P(YSASF,",",YSASC),"I")
72 ..W !,$$C(YSASX,"F"_(YSASC+17))
73 ..S:YSASX="" YSASR=""
74 ..Q:YSASR=""
75 ..S YSASR=YSASR+YSASX
76 ..Q
77 .Q:YSASR=""
78 .S YSASR=YSASR/9
79 .Q
80 I YSASA=""!(YSASB="")!(YSASC="")!(YSASD="")!(YSASR="") W !!,$$EM("Family/Social") Q
81 S YSASA=YSASA/10,YSASB=YSASB/150,YSASC=YSASC/20,YSASD=YSASD/20
82 S YSASR=YSASR/5
83 W !!,$$SM("Family/Social"),$J(YSASA+YSASB+YSASC+YSASD+YSASR,6,4)
84 Q
85 ;
86CSPS ;Composite Score for Psychiatric Status
87 Q:$$FF
88 D:$E(IOST)="C" HDR
89 W !!!,"Items for Psychiatric Composite Scores"
90 W !,"--------------------------------------",!
91 N YSASA,YSASB,YSASC,YSASD,YSASE,YSASF,YSASG,YSASH,YSASI,YSASJ,YSASK
92 S YSASA=$$IF(YSASDA,19.04,"I")
93 W !,$$C(YSASA,"P3")
94 S YSASB=$$IF(YSASDA,19.06,"I")
95 W !,$$C(YSASB,"P4")
96 S YSASC=$$IF(YSASDA,19.08,"I")
97 W !,$$C(YSASC,"P5")
98 S YSASD=$$IF(YSASDA,19.11,"I")
99 W !,$$C(YSASD,"P6")
100 S YSASE=$$IF(YSASDA,19.14,"I")
101 W !,$$C(YSASE,"P7")
102 S YSASF=$$IF(YSASDA,19.16,"I")
103 W !,$$C(YSASF,"P8")
104 S YSASG=$$IF(YSASDA,19.18,"I")
105 W !,$$C(YSASG,"P9")
106 S YSASH=$$IF(YSASDA,19.21,"I")
107 W !,$$C(YSASH,"P10")
108 S YSASI=$$IF(YSASDA,19.23)
109 W !,$$C(YSASI,"P11")
110 S YSASJ=$$IF(YSASDA,19.24)
111 W !,$$C(YSASJ,"P12")
112 S YSASK=$$IF(YSASDA,19.25)
113 W !,$$C(YSASK,"P13")
114 I YSASA=""!(YSASB="")!(YSASC="")!(YSASD="")!(YSASE="")!(YSASF="")!(YSASG="")!(YSASH="")!(YSASI="")!(YSASJ="")!(YSASK="") W !!,$$EM("Paychiatric") Q
115 S YSASA=YSASA/11,YSASB=YSASB/11,YSASC=YSASC/11,YSASD=YSASD/11
116 S YSASE=YSASE/11,YSASF=YSASF/11,YSASG=YSASG/11,YSASH=YSASH/11
117 S YSASI=YSASI/330,YSASJ=YSASJ/44,YSASK=YSASK/44
118 W !!,$$SM("Psychiatric"),$J(YSASA+YSASB+YSASC+YSASD+YSASE+YSASF+YSASG+YSASH+YSASI+YSASJ+YSASK,6,4)
119 Q
120 ;
121FF() ;Form Feed
122 I $E(IOST)'="C" Q 0
123 I $G(YSASQUIT) Q 1
124 N X
125 W !!,"<press <cr> to continue>"
126 R X:DTIME
127 W:$D(IOF) @IOF
128 I $E(X)="^" S YSASQUIT=1 Q 1
129 Q 0
130 ;
131HDR ;Header
132 W !,$$IF(YSASDA,.02)," ASI date of interview: ",$$IF(YSASDA,.05)
133 Q
Note: See TracBrowser for help on using the repository browser.