source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGMTSCU4.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.8 KB
RevLine 
[613]1DGMTSCU4 ;ALB/CMF - Means Test Maximum Annual Pension Rate Utilities ;4 OCT 2004 3:33 pm
2 ;;5.3;Registration;**624**;Aug 13, 1993
3 ;
4 Q
5MEDEXP(DGGRS,DGADJ,DGYR,DGDEP) ;
6 ; in: DGGRS = gross medical expense, default is 0
7 ; DGADJ = adjusted medical expense, default is 0
8 ; DGYR = rate table year
9 ; DGDEP = # of dependents
10 ; out: if gross >0, adjusted medical expense
11 ; if adjusted > 0, gross medical expense (back-compute)
12 ; else 0
13 N DGRTN,DGMAP,DGPER,DGADD
14 ; initialize variables, quit if inappropriate
15 S DGRTN=0
16 S DGGRS=$S(+$G(DGGRS)>0:DGGRS,1:0)
17 S DGADJ=$S(+DGGRS:0,+$G(DGADJ)>0:DGADJ,1:0)
18 Q:(DGGRS=0)&(DGADJ=0) DGRTN
19 S DGYR=$S(+$G(DGYR):DGYR,1:-1)
20 Q:DGYR=-1 DGRTN
21 S DGDEP=$S(+$G(DGDEP):+DGDEP,1:0)
22 ;
23 ; get global % rate
24 S DGPER=$$GET^XPAR("PKG","DGMT MAPR GLOBAL RATE",DGYR)
25 Q:DGPER="" DGRTN
26 ;
27 ; get max annual value
28 I DGDEP=0 S DGMAP=$$GET^XPAR("PKG","DGMT MAPR 0 DEPENDENTS",DGYR)
29 I DGDEP>0 S DGMAP=$$GET^XPAR("PKG","DGMT MAPR 1 DEPENDENTS",DGYR)
30 S DGADD=0
31 D:DGDEP>1
32 .S DGADD=$$GET^XPAR("PKG","DGMT MAPR N DEPENDENTS",DGYR)
33 .S DGADD=DGADD*(DGDEP-1)
34 .Q
35 ;
36 S DGRTN=(DGMAP+DGADD)*DGPER/100
37 D:DGGRS>0
38 .S DGRTN=DGGRS-DGRTN
39 .S DGRTN=$S(DGRTN>0:DGRTN,1:0)
40 .Q
41 ;
42 D:DGADJ>0
43 .S DGRTN=DGADJ+DGRTN
44 .S DGRTN=$S(DGRTN>0:DGRTN,1:0)
45 .Q
46 ;
47 Q DGRTN
48 ;
49ND(DGP1,DGP2,DGP3) ;return # of deps for a test
50 ; in: dgp1:DFN = patient ien
51 ; dgp2:DGMTDT = means test date
52 ; dgp3:DGVIRI = veteran income relation ien
53 ; out: DGND = # of dependents for a test
54 N DGDC,DGNC,DGND,DGSP,DGVIR0,DFN,DGMTDT,DGVIRI
55 S DFN=+$G(DGP1)
56 S DGMTDT=+$G(DGP2)
57 S DGVIRI=+$G(DGP3)
58 Q:(DFN=0)!(DGMTDT=0)!(DGVIRI=0) 0
59 D DEP^DGMTSCU2
60 Q $S(DGND<0:0,DGND<21:DGND,1:20)
61 ;
62GRSADJ(DGP1,DGP2,DGP3,DGP4) ;write adjusted medical expense
63 ;called from [DGMT ENTER/EDIT EXPENSES] edit template
64 ; in: see $$ADJUST
65 ; out: text string with adjusted medical expense
66 N DGADJ
67 S DGADJ=$$ADJUST(DGP1,DGP2,DGP3,DGP4)
68 S DGADJ=$$AMT^DGMTSCU1(DGADJ)
69 Q "ADJUSTED MEDICAL EXPENSES: "_DGADJ_"//"
70 ;
71ADJUST(DGP1,DGP2,DGP3,DGP4) ;derive adjust med exp from gross med exp
72 ; in: dgp1:DGVINI = veteran income test ien
73 ; dgp2:DGDFN = patient ien
74 ; dgp3:DGMTDT = means test date
75 ; dgp4:DGVIRI = veteran income relation ien
76 ; out: adjusted medical expense or -1 if not set
77 N DGND,DGYR,DGGRS,DGADJ,DGVINI,DGDFN,DGMTDT,DGVIRI
78 S DGVINI=+$G(DGP1)
79 S DGDFN=+$G(DGP2)
80 S DGMTDT=+$G(DGP3)
81 S DGVIRI=+$G(DGP4)
82 Q:(DGVINI=0)!(DGDFN=0)!(DGMTDT=0)!(DGVIRI=0) -1
83 Q:'$D(^DGMT(408.21,DGVINI,1)) 0
84 S DGND=$$ND(DGDFN,DGMTDT,DGVIRI)
85 S DGYR=$$YEAR(DGMTDT)
86 S DGGRS=$P(^DGMT(408.21,DGVINI,1),U,12)
87 S DGADJ=$$MEDEXP(DGGRS,,DGYR,DGND)
88 S $P(^DGMT(408.21,DGVINI,1),U)=DGADJ
89 Q DGADJ
90 ;
91GROSS(DGP1,DGP2,DGP3,DGP4) ;derive gross med exp from adj med exp
92 ; in: dgp1:DGVINI = veteran income test ien
93 ; dgp2:DGDFN = patient ien
94 ; dgp3:DGMTDT = means test date
95 ; dgp4:DGVIRI = veteran income relation ien
96 ; out: gross medical expense reset if necessary
97 N DGND,DGYR,DGGRS,DGADJ,DGVINI,DGDFN,DGMTDT,DGVIRI
98 S DGVINI=+$G(DGP1)
99 S DGDFN=+$G(DGP2)
100 S DGMTDT=+$G(DGP3)
101 S DGVIRI=+$G(DGP4)
102 Q:(DGVINI=0)!(DGDFN=0)!(DGMTDT=0)!(DGVIRI=0)
103 Q:'$D(^DGMT(408.21,DGVINI,1))
104 S DGGRS=+$P(^DGMT(408.21,DGVINI,1),U,12)
105 S DGADJ=+$P(^DGMT(408.21,DGVINI,1),U,1)
106 Q:DGGRS+DGADJ=0
107 Q:DGADJ=0
108 S DGND=$$ND(DGDFN,DGMTDT,DGVIRI)
109 S DGYR=$$YEAR(DGMTDT)
110 Q:DGADJ=$$MEDEXP(DGGRS,,DGYR,DGND)
111 S DGGRS=$$MEDEXP(,DGADJ,DGYR,DGND)
112 S $P(^DGMT(408.21,DGVINI,1),U,12)=DGGRS
113 Q
114 ;
115YEAR(DGMTDT) ;get MAPR year from means test date
116 Q $$FMTE^XLFDT($E(DGMTDT,1,3)_"0000",1)-2
117 ;
118AGME101(DGP1) ;force recalculate gross upon FM change to adjusted
119 ; in: dgp1:~DGVINI = veteran income test ien
120 ; out: queued task
121 ; called from AGME101 x-ref of 408.21/1.01
122 N DGVINI
123 S DGVINI=+$G(DGP1)
124 Q:'DGVINI
125 Q:'$D(^DGMT(408.21,DGVINI,1))
126 S $P(^DGMT(408.21,DGVINI,1),U,12)=0
127 Q
128 ;
Note: See TracBrowser for help on using the repository browser.