| 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
 | 
|---|