source: FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGMTSC2.m@ 1267

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

initial load of FOIAVistA 6/30/08 version
File size: 3.2 KB
Line 
1DGMTSC2 ;ALB/RMO/CAW - Means Test Screen Income ;23 JAN 1992 11:00 am [ 10/02/92 8:46 AM ]
2 ;;5.3;Registration;**45**;Aug 13, 1993
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 Means Test IEN
10 ; Output -- None
11 ;
12EN ;Entry point for previous calendar year income screen
13 S DGMTSCI=2 D HD^DGMTSCU
14 D DIS
15 S DGRNG="1-10" G EN^DGMTSCR
16 ;
17EN1 ;Entry point for read processor return
18 D ALL^DGMTU21(DFN,"CS",DGMTDT,"IPR",$S($G(DGMTI):DGMTI,1:""))
19 I DGX!($G(DGSELTY)["V") S DGPRI=DGVPRI,DGPRTY="V" D EDT
20 I '$G(DGMTOUT)&($G(DGSEL)["S")&(DGX!($G(DGSELTY)["S")) S DGPRI=+DGREL("S"),DGPRTY="S" D EDT
21 I '$G(DGMTOUT)&($G(DGSEL)["C")&(DGX!($G(DGSELTY)["C")) S DGPRTY="C",DGCNT=0 F S DGCNT=$O(DGREL("C",DGCNT)) Q:'DGCNT!($G(DGMTOUT)) D
22 .D CHK^DGMTSCU2 I Y S DGPRI=+DGREL("C",DGCNT) D EDT
23Q K DGCNT,DGDEP,DGDR,DGMTOUT,DGPRI,DGPRTY,DGREL,DGSEL,DGSELTY,DGX,DGY,DTOUT,DUOUT,Y
24 G EN
25 ;
26DIS ;Display income
27 N DGDC,DGDET,DGIN0,DGIN1,DGIN2,DGINT,DGINTF,DGNC,DGND,DGNWT,DGNWTF,DGSP,DGVIR0,DGCNT
28 D DEP^DGMTSCU2,INC^DGMTSCU3 S DGCNT=1
29 W !!?34,"Veteran" W:DGSP ?46,"Spouse" W:DGDC ?56,"Children" W ?73,"Total"
30 W !?31,"-----------------------------------------------"
31 D HIGH^DGMTSCU1(1,DGMTACT),FLD(.DGIN0,8,"Social Security (Not SSI)")
32 D HIGH^DGMTSCU1(2,DGMTACT),FLD(.DGIN0,9,"U.S. Civil Service")
33 D HIGH^DGMTSCU1(3,DGMTACT),FLD(.DGIN0,10,"U.S. Railroad Retirement")
34 D HIGH^DGMTSCU1(4,DGMTACT),FLD(.DGIN0,11,"Military Retirement")
35 D HIGH^DGMTSCU1(5,DGMTACT),FLD(.DGIN0,12,"Unemployment Compensation")
36 D HIGH^DGMTSCU1(6,DGMTACT),FLD(.DGIN0,13,"Other Retirement")
37 D HIGH^DGMTSCU1(7,DGMTACT),FLD(.DGIN0,14,"Total Employment Income")
38 D HIGH^DGMTSCU1(8,DGMTACT),FLD(.DGIN0,15,"Interest,Dividend,Annuity")
39 D HIGH^DGMTSCU1(9,DGMTACT),FLD(.DGIN0,16,"Workers Comp or Black Lung")
40 D HIGH^DGMTSCU1(10,DGMTACT),FLD(.DGIN0,17,"All Other Income")
41 W !?51,"Total -->",?66,$J($$AMT^DGMTSCU1(DGINT),12)
42 Q
43 ;
44FLD(DGIN,DGPCE,DGTXT) ;Display income fields
45 ;
46 ; Input -- DGIN as Individual Annual Income 0 node for vet,
47 ; spouse, and dependents
48 ; DGPCE as piece position wanted
49 ; DGTXT as income description
50 ;
51 ; Also keeps running total if DGGTOT is defined (grand
52 ; total)
53 ;
54 N DGTOT,I
55 I '$D(DGBL) S $P(DGBL," ",26)=""
56 W:DGCNT<10 " "
57 W " ",$E(DGTXT_DGBL,1,26)
58 W $J($$AMT^DGMTSCU1($P(DGIN("V"),"^",DGPCE)),10)
59 W " ",$S($D(DGIN("S")):$J($$AMT^DGMTSCU1($P(DGIN("S"),"^",DGPCE)),10),1:$E(DGBL,1,10))
60 W " ",$S($D(DGIN("C")):$J($$AMT^DGMTSCU1($P(DGIN("C"),"^",DGPCE)),11),1:$E(DGBL,1,11))
61 S DGTOT="",I="" F S I=$O(DGIN(I)) Q:I="" I $P(DGIN(I),"^",DGPCE)]"" S DGTOT=DGTOT+$P(DGIN(I),"^",DGPCE)
62 W " ",$J($$AMT^DGMTSCU1(DGTOT),12)
63 S DGCNT=DGCNT+1
64 Q
65 ;
66EDT ;Edit income fields
67 N DA,DGERR,DGFIN,DGINI,DGIN0,DGIRI,DIE,DR
68 D GETIENS^DGMTU2(DFN,DGPRI,DGMTDT) G EDTQ:DGERR
69 I $G(DGSEL)]"" W !!,"NAME: ",$$NAME^DGMTU1(DGPRI)
70 S DGIN0=$G(^DGMT(408.21,DGINI,0))
71 S DA=DGINI,DIE="^DGMT(408.21,",DR="[DGMT ENTER/EDIT ANNUAL INCOME]" D ^DIE S:'$D(DGFIN) DGMTOUT=1
72 I DGIN0'=$G(^DGMT(408.21,DGINI,0)) S DR="103////^S X=DUZ;104///^S X=""NOW""" D ^DIE
73EDTQ Q
Note: See TracBrowser for help on using the repository browser.