source: FOIAVistA/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASECSC5.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 4.1 KB
Line 
1EASECSC5 ;ALB/PHH,LBD - LTC Co-Pay Test Screen Income ;13 AUG 2001
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,7,40**;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 ; DGFORM 10-10EC Format (1=Revised; 0=Original)
11 ; Output -- None
12 ;
13EN ;Entry point for calendar year income screen
14 S DGMTSCI=5 D HD^EASECSCU
15 D DIS
16 S DGRNG=$S($G(DGFORM):"1-3",1:"1-14") G EN^EASECSCR
17 ;
18EN1 ;Entry point for read processor return
19 D ALL^EASECU21(DFN,"S",DGMTDT,"IPR",$S($G(DGMTI):DGMTI,1:""))
20 I DGX!($G(DGSELTY)["V") S DGPRI=DGVPRI,DGPRTY="V" D EDT
21 I '$G(DGMTOUT)&($G(DGSEL)["S")&(DGX!($G(DGSELTY)["S")) S DGPRI=+DGREL("S"),DGPRTY="S" D EDT
22Q K DGCNT,DGDEP,DGDR,DGMTOUT,DGPRI,DGPRTY,DGREL,DGSEL,DGSELTY,DGX,DGY,DTOUT,DUOUT,Y
23 G EN
24 ;
25DIS ;Display income
26 N DGDC,DGDET,DGIN0,DGIN1,DGIN2,DGINT,DGINTF,DGNC,DGND,DGNWT,DGNWTF,DGSP,DGVIR0,DGCNT
27 D DEP^EASECSU3,INC^EASECSU3 S DGCNT=1
28 W !!?39,"Veteran" W:DGSP ?56,"Spouse" W ?73,"Total"
29 W !?36,"------------------------------------------"
30 ; Revised 10-10EC format, added for LTC IV (EAS*1*40)
31 I $G(DGFORM) D
32 .D HIGH^DGMTSCU1(1,DGMTACT),FLD(.DGIN0,14,"Current Employment Income")
33 .D HIGH^DGMTSCU1(2,DGMTACT),FLD(.DGIN0,15,"Income from Farm/Ranch/Business")
34 .D HIGH^DGMTSCU1(3,DGMTACT),FLD(.DGIN0,17,"All Other Income")
35 ; Original 10-10EC format
36 I '$G(DGFORM) D
37 .D HIGH^DGMTSCU1(1,DGMTACT),FLD(.DGIN0,14,"Current Income")
38 .D HIGH^DGMTSCU1(2,DGMTACT),FLD(.DGIN0,8,"Soc. Sec. Retire/Disabil")
39 .D HIGH^DGMTSCU1(3,DGMTACT),FLD(.DGIN0,15,"Interest/Dividends")
40 .D HIGH^DGMTSCU1(4,DGMTACT),FLD(.DGIN0,6,"Retirement/Pension Income")
41 .D HIGH^DGMTSCU1(5,DGMTACT),FLD(.DGIN0,9,"Civil Service Retirement")
42 .D HIGH^DGMTSCU1(6,DGMTACT),FLD(.DGIN0,10,"U.S. Railroad Retirement")
43 .D HIGH^DGMTSCU1(7,DGMTACT),FLD(.DGIN0,7,"VA Pension")
44 .D HIGH^DGMTSCU1(8,DGMTACT),FLD(.DGIN0,19,"Spouse VA Disabil/Compens")
45 .D HIGH^DGMTSCU1(9,DGMTACT),FLD(.DGIN0,12,"Unemployment Benefit/Comp")
46 .D HIGH^DGMTSCU1(10,DGMTACT),FLD(.DGIN0,16,"Other Compensation")
47 .D HIGH^DGMTSCU1(11,DGMTACT),FLD(.DGIN0,11,"Military Retirement")
48 .D HIGH^DGMTSCU1(12,DGMTACT),FLD(.DGIN0,13,"Other Retirement")
49 .D HIGH^DGMTSCU1(13,DGMTACT),FLD(.DGIN0,20,"Court Mandated")
50 .D HIGH^DGMTSCU1(14,DGMTACT),FLD(.DGIN0,17,"Other Income")
51 W !?56,"Total -->",?66,$J($$AMT^DGMTSCU1(DGINT),12)
52 Q
53 ;
54FLD(DGIN,DGPCE,DGTXT) ;Display income fields
55 ;
56 ; Input -- DGIN as Individual Annual Income 0 node for vet,
57 ; spouse, and dependents
58 ; DGPCE as piece position wanted
59 ; DGTXT as income description
60 ;
61 ; Also keeps running total if DGGTOT is defined (grand
62 ; total)
63 ;
64 N DGTOT,I,AMT
65 I '$D(DGBL) S $P(DGBL," ",26)=""
66 W:DGCNT<10 " "
67 W " ",$E(DGTXT_DGBL,1,26)
68 ; Display veteran amount
69 S AMT=$$AMT^DGMTSCU1($P(DGIN("V"),U,DGPCE))
70 ; No amount for Spouse VA Disability/Compensation
71 I DGPCE=19 S AMT="N/A"
72 ; No amount for VA Pension if Receiving VA Pension is not YES
73 I DGPCE=7,$P($G(^DPT(DFN,.362)),U,14)'="Y" S AMT="N/A"
74 W $J(AMT,15)
75 ; Display spouse amount (if married)
76 W " ",$S($D(DGIN("S")):$J($$AMT^DGMTSCU1($P(DGIN("S"),"^",DGPCE)),15),1:$E(DGBL,1,15))
77 W " "
78 S DGTOT="",I="" F S I=$O(DGIN(I)) Q:I="" I $P(DGIN(I),"^",DGPCE)]"" S DGTOT=DGTOT+$P(DGIN(I),"^",DGPCE)
79 W " ",$J($$AMT^DGMTSCU1(DGTOT),12)
80 S DGCNT=DGCNT+1
81 Q
82 ;
83EDT ;Edit income fields
84 N DA,DGERR,DGFIN,DGINI,DGIN0,DGIRI,DIE,DR
85 D GETIENS^EASECU2(DFN,DGPRI,DGMTDT) G EDTQ:DGERR
86 I $G(DGSEL)]"" W !!,"NAME: ",$$NAME^DGMTU1(DGPRI)
87 S DGIN0=$G(^DGMT(408.21,DGINI,0))
88 ; If this is the new 10-10EC form use the template [EASEC ENTER/EDIT
89 ; INCOME NEW]. Added for LTC IV (EAS*1*40).
90 S DA=DGINI,DIE="^DGMT(408.21,",DR="[EASEC ENTER/EDIT INCOME"_$S($G(DGFORM):" NEW]",1:"]")
91 D ^DIE S:'$D(DGFIN) DGMTOUT=1
92 I DGIN0'=$G(^DGMT(408.21,DGINI,0)) D
93 .S DR="103////^S X=DUZ;104///^S X=""NOW"""
94 .I '$G(^DGMT(408.21,DGINI,"MT")) S DR=DR_";31////^S X=$G(DGMTI)"
95 .D ^DIE
96EDTQ Q
Note: See TracBrowser for help on using the repository browser.