source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGMTSC3.m@ 1766

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

initial load of WorldVistAEHR

File size: 1.7 KB
Line 
1DGMTSC3 ;ALB/RMO/CAW - Means Test Screen Deductible Expense ;23 JAN 1992 11:00 am [ 10/02/92 11:31 AM ]
2 ;;5.3;Registration;**624**;Aug 13, 1993
3 ;
4 ; Input -- DGVINI Veteran Individual Annual Income IEN
5 ; DGVIRI Veteran Income Relation IEN
6 ; DGVPRI Veteran Patient Relation IEN
7 ; Output -- None
8 ;
9EN ;Entry point for deductible expense screen
10 S DGMTSCI=3 D HD^DGMTSCU
11 D DIS
12 S DGRNG="1-"_$S('DGDC:1,1:2) G EN^DGMTSCR
13EN1 ;Entry point for read processor return
14 S DGVIR0=$G(^DGMT(408.22,DGVIRI,0)),DGIN1("V")=$G(^DGMT(408.21,DGVINI,1))
15 S DA=DGVINI,DIE="^DGMT(408.21,",DR="[DGMT ENTER/EDIT EXPENSES]" D ^DIE S:'$D(DGFIN) DGMTOUT=1
16 I DGIN1("V")'=$G(^DGMT(408.21,DGVINI,1)) S DR="103////^S X=DUZ;104///^S X=""NOW""" D ^DIE K DA,DIE,DR
17 I '$G(DGMTOUT),DGDR["102" D EN^DGMTSC31
18Q K DGDC,DGDR,DGFIN,DGIN1,DGMTOUT,DGREL,DGVIR0,DGX,DGY,DTOUT,DUOUT
19 G EN
20 ;
21DIS ;Display deductible expenses
22 N DGCNT,DGDCS,DGDEP,DGIN1,DGINC,DGINR,DGREL,DGVIR0
23 S DGVIR0=$G(^DGMT(408.22,DGVIRI,0)),DGIN1("V")=$G(^DGMT(408.21,DGVINI,1))
24 S DGDC=$P(DGVIR0,"^",8) I DGDC D SET^DGMTSC31 S:'$D(DGDCS) DGDC=0
25 D HIGH^DGMTSCU1(1,DGMTACT) W $J("Gross Medical Expenses: ",33),$S(+$P(DGIN1("V"),"^",12)'<0:$$AMT^DGMTSCU1(+$P(DGIN1("V"),"^",12)),1:"N/A")
26 W !,$J("Adjusted Medical Expenses: ",36),$S(+$P(DGIN1("V"),"^")'<0:$$AMT^DGMTSCU1(+$P(DGIN1("V"),"^")),1:"N/A")
27 W !,$J("Funeral and Burial Expenses: ",36),$S('$P(DGVIR0,"^",5)&('$P(DGVIR0,"^",8)):"N/A",1:$$AMT^DGMTSCU1($P(DGIN1("V"),"^",2)))
28 W !,$J("Veteran's Educational Expenses: ",36),$$AMT^DGMTSCU1($P(DGIN1("V"),"^",3))
29 W ! D HIGH^DGMTSCU1(2,DGMTACT) W ?7," Child's Education Expenses: ",$S('DGDC:"N/A",1:"") D DIS^DGMTSC31:DGDC
30 Q
Note: See TracBrowser for help on using the repository browser.