| [613] | 1 | EASECSC5 ;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 | ;
|
|---|
| 13 | EN ;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 | ;
|
|---|
| 18 | EN1 ;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
|
|---|
| 22 | Q K DGCNT,DGDEP,DGDR,DGMTOUT,DGPRI,DGPRTY,DGREL,DGSEL,DGSELTY,DGX,DGY,DTOUT,DUOUT,Y
|
|---|
| 23 | G EN
|
|---|
| 24 | ;
|
|---|
| 25 | DIS ;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 | ;
|
|---|
| 54 | FLD(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 | ;
|
|---|
| 83 | EDT ;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
|
|---|
| 96 | EDTQ Q
|
|---|
