source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGMTSC4.m@ 1259

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

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1DGMTSC4 ;ALB/RMO/CAW,LBD - Means Test Screen Net Worth ; 11/7/03 1:44pm
2 ;;5.3;Registration;**45,130,456,540,567**;Aug 13, 1993
3 ;
4 ; Input -- DFN Patient IEN
5 ; DGMTDT Date of Test
6 ; DGMTYPT Type of Test 1=MT 2=COPAY
7 ; DGMTPAR Annual Means Test Parameter Array
8 ; DGVINI Veteran Individual Annual Income IEN
9 ; DGVIRI Veteran Income Relation IEN
10 ; DGVPRI Veteran Patient Relation IEN
11 ; DGMTNWC Net Worth Calculation flag
12 ; Output -- None
13 ;
14 ;DG*5.3*540 - Skip displaying of calculated Means Test Status at the
15 ; bottom of screen 4 when in VIEW mode.
16 ;DG*5.3*567 - Allow bottom to show for all except SOURCE OF TEST[IVM
17 ; for IVM display Source is IVM instead.
18 ;
19EN ;Entry point for previous calendar year net worth screen
20 S DGMTSCI=4 D HD^DGMTSCU
21 D DIS
22 S DGRNG="1-5" G EN^DGMTSCR
23 ;
24EN1 ;Entry point for read processor return
25 D ALL^DGMTU21(DFN,"S",DGMTDT,"IPR",$S($G(DGMTI):DGMTI,1:""))
26 I DGX!($G(DGSELTY)["V") S DGPRI=DGVPRI,DGPRTY="V" D EDT
27 I '$G(DGMTOUT)&($G(DGSEL)["S")&(DGX!($G(DGSELTY)["S")) S DGPRI=+DGREL("S"),DGPRTY="S" D EDT
28Q K DGCNT,DGDEP,DGDR,DGMTOUT,DGPRI,DGPRTY,DGREL,DGSEL,DGSELTY,DGX,DGY,DTOUT,DUOUT,Y
29 G EN
30 ;
31DIS ;Display net worth
32 N DGCAT,DGDC,DGDET,DGIN0,DGIN1,DGIN2,DGINT,DGINTF,DGMTS,DGNC,DGND,DGNWT,DGNWTF,DGSP,DGTYC,DGTHA,DGTHB,DGTHG,DGVIR0,DGCNT
33 D SET^DGMTSCU2 S DGCNT=1
34 I DGMTYPT=1 W !,"Income Thresholds: " W:$D(DGTHA) "MT Threshold: ",$$AMT^DGMTSCU1(DGTHA) W:$D(DGTHG) ?53,"GMT Threshold: ",$$AMT^DGMTSCU1(DGTHG)
35 W ! W:$D(DGMTPAR("PREV")) "*Previous Years Thresholds*"
36 W ?34,"Veteran" W:DGSP ?46,"Spouse" W ?73,"Total"
37 W !?31,"-----------------------------------------------"
38 D HIGH^DGMTSCU1(1,DGMTACT),FLD(.DGIN2,1,"Cash, Amts in Bank Accts")
39 D HIGH^DGMTSCU1(2,DGMTACT),FLD(.DGIN2,2,"Stocks and Bonds")
40 D HIGH^DGMTSCU1(3,DGMTACT),FLD(.DGIN2,3,"Real Property")
41 D HIGH^DGMTSCU1(4,DGMTACT),FLD(.DGIN2,4,"Other Property or Assets")
42 D HIGH^DGMTSCU1(5,DGMTACT),FLD(.DGIN2,5,"Debts")
43 W !?51,"Total -->",?66,$J($$AMT^DGMTSCU1(DGNWT),12)
44 I DGMTYPT=1,DGMTACT="VEW",$P($G(DGMT0),"^",14) W !!!!!!!!,"Declines to give income information makes a MT COPAY REQUIRED status." G DISQ
45 ;
46 ;DG*5.3*540
47 ;DG*5.3*567
48 I DGMTACT="VEW",DGMTI,$$GET1^DIQ(408.31,DGMTI,.23)["IVM" D G DISQ
49 . W !!!!!!!!,"Source of Test is IVM"
50 W !!!!!!!! I DGMTYPT=1 W "Income of ",$J($$AMT^DGMTSCU1(DGINT-DGDET),12) W " ",$$GETNAME^DGMTH(DGMTS)
51 I DGMTYPT=1,DGTYC="M",(DGNWT-DGDET)+$S($G(DGMTNWC):0,1:DGINT)'<$P(DGMTPAR,"^",8) W !,?3,"with property of ",$J($$AMT^DGMTSCU1(DGNWT),12)," makes a ",$S(DGTHG>DGTHA:"G",1:""),"MT COPAY REQUIRED status."
52 I DGTYC="M",'DGNWTF W " requires property information."
53 I DGMTYPT=2,'DGNWTF,DGCAT="E" W "Requires property information."
54DISQ Q
55 ;
56FLD(DGIN,DGPCE,DGTXT) ;Display income fields
57 ;
58 ; Input -- DGIN as Individual Annual Income 0 node for vet,
59 ; spouse, and dependents
60 ; DGRPCE as piece position wanted
61 ; DGTXT as income description
62 ;
63 ; Also keeps running total if DGGTOT is defined (grand
64 ; total)
65 ;
66 N DGTOT,I
67 I '$D(DGBL) S $P(DGBL," ",26)=""
68 W:DGCNT<10 " "
69 W " ",$E(DGTXT_DGBL,1,26)
70 W $J($$AMT^DGMTSCU1($P(DGIN("V"),"^",DGPCE)),10)
71 W " ",$S($D(DGIN("S")):$J($$AMT^DGMTSCU1($P(DGIN("S"),"^",DGPCE)),10),1:$E(DGBL,1,10))
72 W " ",$S($D(DGIN("D")):$J($$AMT^DGMTSCU1($P(DGIN("D"),"^",DGPCE)),11),1:$E(DGBL,1,11))
73 S DGTOT="",I="" F S I=$O(DGIN(I)) Q:I="" I $P(DGIN(I),"^",DGPCE)]"" S DGTOT=DGTOT+$P(DGIN(I),"^",DGPCE)
74 W " ",$J($$AMT^DGMTSCU1(DGTOT),12)
75 S DGCNT=DGCNT+1
76 Q
77 ;
78EDT ;Edit net worth fields
79 N DA,DGERR,DGFIN,DGINI,DGIN2,DGIRI,DIE,DR
80 D GETIENS^DGMTU2(DFN,DGPRI,DGMTDT) G EDTQ:DGERR
81 I $G(DGSEL)]"" W !!,"NAME: ",$$NAME^DGMTU1(DGPRI)
82 S DGIN2=$G(^DGMT(408.21,DGINI,2))
83 S DA=DGINI,DIE="^DGMT(408.21,",DR="[DGMT ENTER/EDIT NET WORTH]" D ^DIE S:'$D(DGFIN) DGMTOUT=1
84 I DGIN2'=$G(^DGMT(408.21,DGINI,2)) S DR="103////^S X=DUZ;104///^S X=""NOW""" D ^DIE
85EDTQ Q
Note: See TracBrowser for help on using the repository browser.