1 | EASECSC6 ;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 | ;
|
---|
12 | EN ;Entry point for expense screen
|
---|
13 | S DGMTSCI=6 D HD^EASECSCU
|
---|
14 | D DIS
|
---|
15 | S DGRNG="1-10" G EN^EASECSCR
|
---|
16 | ;
|
---|
17 | EN1 ;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
|
---|
20 | Q K DGCNT,DGDEP,DGDR,DGMTOUT,DGPRI,DGPRTY,DGREL,DGSEL,DGSELTY,DGX,DGY,DTOUT,DUOUT,Y
|
---|
21 | G EN
|
---|
22 | ;
|
---|
23 | DIS ;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 | ;
|
---|
41 | FLD(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 | ;
|
---|
63 | EDT ;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
|
---|
74 | EDTQ Q
|
---|