source: WorldVistAEHR/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASECSC6.m@ 1306

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

initial load of WorldVistAEHR

File size: 2.8 KB
Line 
1EASECSC6 ;ALB/PHH,LBD - LTC Co-Pay Test Screen Deductible Expense ;13 AUG 2001
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,7,34**;Mar 15, 2001
3 ;
4 ; Input -- DFN Patient IEN
5 ; DGMTDT Date of Test
6 ; DGVINI Veteran Individual Annual Income IEN
7 ; DGVIRI Veteran Income Relation IEN
8 ; DGVPRI Veteran Patient Relation IEN
9 ; DGMTI LTC Co-Pay Test IEN
10 ; Output -- None
11 ;
12EN ;Entry point for expense screen
13 S DGMTSCI=6 D HD^EASECSCU
14 D DIS
15 S DGRNG="1-10" G EN^EASECSCR
16 ;
17EN1 ;Entry point for read processor return
18 D ALL^EASECU21(DFN,"CS",DGMTDT,"IPR",$S($G(DGMTI):DGMTI,1:""))
19 I DGX!($G(DGSELTY)["V") S DGPRI=DGVPRI,DGPRTY="V" D EDT
20Q K DGCNT,DGDEP,DGDR,DGMTOUT,DGPRI,DGPRTY,DGREL,DGSEL,DGSELTY,DGX,DGY,DTOUT,DUOUT,Y
21 G EN
22 ;
23DIS ;Display deductible expenses
24 N DGDC,DGDET,DGIN0,DGIN1,DGIN2,DGINT,DGINTF,DGNC,DGND,DGNWT,DGNWTF,DGSP,DGVIR0,DGCNT
25 D DEP^EASECSU3,INC^EASECSU3 S DGCNT=1
26 W !!?39,"Veteran" W:DGSP " and Spouse" W ?73,"Total"
27 W !?36,"------------------------------------------"
28 D HIGH^DGMTSCU1(1,DGMTACT),FLD(.DGIN1,3,"Education")
29 D HIGH^DGMTSCU1(2,DGMTACT),FLD(.DGIN1,2,"Funeral and Burial")
30 D HIGH^DGMTSCU1(3,DGMTACT),FLD(.DGIN1,4,"Rent/Mortgage")
31 D HIGH^DGMTSCU1(4,DGMTACT),FLD(.DGIN1,5,"Utilities")
32 D HIGH^DGMTSCU1(5,DGMTACT),FLD(.DGIN1,6,"Car Payment Only")
33 D HIGH^DGMTSCU1(6,DGMTACT),FLD(.DGIN1,7,"Food")
34 D HIGH^DGMTSCU1(7,DGMTACT),FLD(.DGIN1,1,"Non-reimbursed Medical Expenses")
35 D HIGH^DGMTSCU1(8,DGMTACT),FLD(.DGIN1,8,"Court-ordered Payments")
36 D HIGH^DGMTSCU1(9,DGMTACT),FLD(.DGIN1,9,"Insurance")
37 D HIGH^DGMTSCU1(10,DGMTACT),FLD(.DGIN1,10,"Taxes")
38 W !?56,"Total -->",?66,$J($$AMT^DGMTSCU1(DGDET),12)
39 Q
40 ;
41FLD(DGIN,DGPCE,DGTXT) ;Display income fields
42 ;
43 ; Input -- DGIN as Individual Annual Income 0 node for vet,
44 ; spouse, and dependents
45 ; DGPCE as piece position wanted
46 ; DGTXT as income description
47 ;
48 ; Also keeps running total if DGGTOT is defined (grand
49 ; total)
50 ;
51 N DGTOT,I,AMT
52 I '$D(DGBL) S $P(DGBL," ",26)=""
53 W:DGCNT<10 " "
54 W " ",$E(DGTXT_DGBL,1,26)
55 S AMT=$$AMT^DGMTSCU1($P(DGIN("V"),U,DGPCE))
56 W $J(AMT,15)
57 W " "
58 S DGTOT="",I="" F S I=$O(DGIN(I)) Q:I="" I $P(DGIN(I),"^",DGPCE)]"" S DGTOT=DGTOT+$P(DGIN(I),"^",DGPCE)
59 W " ",$J($$AMT^DGMTSCU1(DGTOT),12)
60 S DGCNT=DGCNT+1
61 Q
62 ;
63EDT ;Edit income fields
64 N DA,DGERR,DGFIN,DGINI,DGIN0,DGIRI,DGVIR0,DIE,DR
65 D GETIENS^EASECU2(DFN,DGPRI,DGMTDT) G EDTQ:DGERR
66 I $G(DGSEL)]"" W !!,"NAME: ",$$NAME^DGMTU1(DGPRI)
67 S DGVIR0=$G(^DGMT(408.22,DGVIRI,0))
68 S DGIN1=$G(^DGMT(408.21,DGINI,1))
69 S DA=DGINI,DIE="^DGMT(408.21,",DR="[EASEC ENTER/EDIT EXPENSES]" D ^DIE S:'$D(DGFIN) DGMTOUT=1
70 I DGIN1'=$G(^DGMT(408.21,DGINI,1)) D
71 .S DR="103////^S X=DUZ;104///^S X=""NOW"""
72 .I '$G(^DGMT(408.21,DGINI,"MT")) S DR=DR_";31////^S X=$G(DGMTI)"
73 .D ^DIE
74EDTQ Q
Note: See TracBrowser for help on using the repository browser.