source: WorldVistAEHR/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASECSC4.m@ 1766

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

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1EASECSC4 ;ALB/PHH,LBD - LTC Co-Pay Test Screen Assets ;10 AUG 2001
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,40**;Mar 15, 2001
3 ;
4 ; Input -- DFN Patient IEN
5 ; DGMTDT Date of Test
6 ; DGMTYPT Type of Test 3=LTC Co-Pay
7 ; DGMTPAR Annual Test Parameter Array
8 ; DGVINI Veteran Individual Annual Income IEN
9 ; DGVIRI Veteran Income Relation IEN
10 ; DGVPRI Veteran Patient Relation IEN
11 ; DGFORM 10-10EC Format (1=Revised; 0=Original)
12 ; Output -- None
13 ;
14EN ;Entry point for net worth screen
15 S DGMTSCI=4 D HD^EASECSCU
16 D DIS
17 S DGRNG=$S($G(DGFORM):"1-5",1:"1-6") G EN^EASECSCR
18 ;
19EN1 ;Entry point for read processor return
20 D ALL^EASECU21(DFN,"S",DGMTDT,"IPR",$S($G(DGMTI):DGMTI,1:""))
21 I DGX!($G(DGSELTY)["V") S DGPRI=DGVPRI,DGPRTY="V" D EDT
22 I '$G(DGMTOUT)&($G(DGSEL)["S")&(DGX!($G(DGSELTY)["S")) S DGPRI=+DGREL("S"),DGPRTY="S" D EDT
23Q K DGCNT,DGDEP,DGDR,DGMTOUT,DGPRI,DGPRTY,DGREL,DGSEL,DGSELTY,DGX,DGY,DTOUT,DUOUT,Y
24 G EN
25 ;
26DIS ;Display net worth
27 N DGCAT,DGDC,DGDET,DGIN0,DGIN1,DGIN2,DGINT,DGINTF,DGMTS,DGNC,DGND,DGNWT,DGNWTF,DGSP,DGTYC,DGTHA,DGTHB,DGVIR0,DGCNT
28 D DEP^EASECSU3,INC^EASECSU3 S DGCNT=1
29 ; Revised 10-10EC form uses separate columns for veteran and spouse
30 ; added for LTC Phase IV (EAS*1*40)
31 I $G(DGFORM) W !?39,"Veteran" W:DGSP ?56,"Spouse" W ?73,"Total"
32 E W !?39,"Veteran" W:DGSP " and Spouse" W ?73,"Total"
33 W !?36,"------------------------------------------"
34 D HIGH^DGMTSCU1(1,DGMTACT),FLD(.DGIN2,6,"Residence")
35 D HIGH^DGMTSCU1(2,DGMTACT),FLD(.DGIN2,7,"Other Residences/Land/Farm/or Ranch")
36 D HIGH^DGMTSCU1(3,DGMTACT),FLD(.DGIN2,8,"Vehicle(s)")
37 ; Revised 10-10EC format, added for LTC IV (EAS*1*40)
38 I $G(DGFORM) D
39 .D HIGH^DGMTSCU1(4,DGMTACT),FLD(.DGIN2,1,"Cash, Stocks, Mutual Funds")
40 .D HIGH^DGMTSCU1(5,DGMTACT),FLD(.DGIN2,9,"Other Liquid Assets")
41 ; Original 10-10EC format
42 I '$G(DGFORM) D
43 .D HIGH^DGMTSCU1(4,DGMTACT),FLD(.DGIN2,1,"Cash")
44 .D HIGH^DGMTSCU1(5,DGMTACT),FLD(.DGIN2,2,"Stocks, Bonds, Mutual Funds, SEP's")
45 .D HIGH^DGMTSCU1(6,DGMTACT),FLD(.DGIN2,9,"Other Liquid Assets")
46 W !?56,"Total -->",?66,$J($$AMT^DGMTSCU1(DGNWT),12)
47DISQ Q
48 ;
49FLD(DGIN,DGPCE,DGTXT) ;Display income fields
50 ;
51 ; Input -- DGIN as Individual Annual Income 0 node for vet,
52 ; spouse, and dependents
53 ; DGRPCE as piece position wanted
54 ; DGTXT as income description
55 ;
56 ; Also keeps running total if DGGTOT is defined (grand
57 ; total)
58 ;
59 N DGTOT,I
60 I '$D(DGBL) S $P(DGBL," ",26)=""
61 W:DGCNT<10 " "
62 W " ",$E(DGTXT_DGBL,1,26)
63 W $J($$AMT^DGMTSCU1($P(DGIN("V"),"^",DGPCE)),15)
64 ; Display spouse amount if married (only applies to new 10-10EC form)
65 ; Added for LTC Phase IV (EAS*1*40)
66 W " ",$S($D(DGIN("S"))&($G(DGFORM)):$J($$AMT^DGMTSCU1($P(DGIN("S"),"^",DGPCE)),15),1:$E(DGBL,1,15))
67 W " "
68 S DGTOT="",I="" F S I=$O(DGIN(I)) Q:I="" I $P(DGIN(I),"^",DGPCE)]"" S DGTOT=DGTOT+$P(DGIN(I),"^",DGPCE)
69 W " ",$J($$AMT^DGMTSCU1(DGTOT),12)
70 S DGCNT=DGCNT+1
71 Q
72 ;
73EDT ;Edit net worth fields
74 N DA,DGERR,DGFIN,DGINI,DGIN2,DGIRI,DIE,DR
75 D GETIENS^EASECU2(DFN,DGPRI,DGMTDT) G EDTQ:DGERR
76 I $G(DGSEL)]"" W !!,"NAME: ",$$NAME^DGMTU1(DGPRI)
77 S DGIN2=$G(^DGMT(408.21,DGINI,2))
78 ; If this is the new 10-10EC form use the template [EASEC ENTER/EDIT
79 ; ASSETS NEW]. Added for LTC IV (EAS*1*40).
80 S DA=DGINI,DIE="^DGMT(408.21,",DR="[EASEC ENTER/EDIT ASSETS"_$S($G(DGFORM):" NEW]",1:"]")
81 D ^DIE S:'$D(DGFIN) DGMTOUT=1
82 I DGIN2'=$G(^DGMT(408.21,DGINI,2)) D
83 .S DR="103////^S X=DUZ;104///^S X=""NOW"""
84 .I '$G(^DGMT(408.21,DGINI,"MT")) S DR=DR_";31////^S X=$G(DGMTI)"
85 .D ^DIE
86EDTQ Q
Note: See TracBrowser for help on using the repository browser.