source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGRP9.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: 5.0 KB
Line 
1DGRP9 ;ALB/RMO/MIR - Screen 9 - Income Screening Data ;23 JAN 1992 11:00 am
2 ;;5.3;Registration;**45,108,487**;Aug 13, 1993
3 ;
4EN ;
5 ; DVBGUI : CAPRI GUI User
6 I $D(DVBGUI) U IO ;If called from CAPRI menu set output device.
7 K DGDEP,DGINC,DGREL N DGMT,DGEFDT,DGEFDT,DGMTED,DGNOBUCK,DGLSTYR
8 S DGLSTYR=$E(DT,1,3)+1699
9 S DGRPS=9 D H^DGRPU
10 D:'DGRPV NEW^DGRPEIS1
11 D ALL^DGMTU21(DFN,"VSD",DT,"IPR")
12 S DGNOBUCK=$S(DGRPV:0,1:$$NOBUCKS^DGMTU22(DFN,DT))
13 S DGMT=$$LST^DGMTU(DFN,DT),DGEFDT=$P(DGMT,U,2)
14 S:'((DGEFDT+10000)>DT&("^A^C^P^E^M^"[(U_$P(DGMT,U,4)))&DGNOBUCK) DGEFDT=DT
15 S DGISYR=$E($$LYR^DGMTSCU1(DGEFDT),1,3)+1700 ; IS year
16 D:DT'=DGEFDT ALL^DGMTU21(DFN,"VSD",DGEFDT,"IPR")
17 S DGSP=$D(DGREL("S")) ; DGSP = flag ... + if spouse, 0 if not
18 D TOT(.DGINC)
19 D DIS
20 W:DGNOBUCK !," NOTE: Since there is no income data for "_DGLSTYR_" you may COPY "_(DGLSTYR-1)_" data."
21 K DGTOT
22 G ^DGRPP
23 ;
24DIS ;Display income
25 D MTCHK
26 N DGBL
27 W !!?34,"Veteran" W:DGSP ?46,"Spouse" W:DGDEP ?56,"Dependents" W ?73,"Total"
28 W !?31,"-----------------------------------------------"
29 S DGGTOT=0,DGRPW=1 ;initialize grand total variable
30 S Z=1 D WW^DGRPV D FLD(.DGTOT,8,"Social Security (Not SSI)")
31 S Z=2 D WW^DGRPV D FLD(.DGTOT,9,"U.S. Civil Service")
32 S Z=3 D WW^DGRPV D FLD(.DGTOT,10,"U.S. Railroad Retirement")
33 S Z=4 D WW^DGRPV D FLD(.DGTOT,11,"Military Retirement")
34 S Z=5 D WW^DGRPV D FLD(.DGTOT,12,"Unemployment Compensation")
35 S Z=6 D WW^DGRPV D FLD(.DGTOT,13,"Other Retirement")
36 S Z=7 D WW^DGRPV D FLD(.DGTOT,14,"Total Employment Income")
37 S Z=8 D WW^DGRPV D FLD(.DGTOT,15,"Interest,Dividend,Annuity")
38 S Z=9 D WW^DGRPV D FLD(.DGTOT,16,"Workers Comp or Black Lung")
39 S Z=10 D WW^DGRPV D FLD(.DGTOT,17,"All Other Income")
40 W !,DGBL,DGBL," Total 1-10 -->"," ",$J($$AMT^DGMTSCU1(DGGTOT),12)
41 ;
42 ;** Patch DG*5.3*108; estimated household income follows
43 W !!,DGISYR_" Estimated ""Household"" Taxable Income: "_$S($P(DGTOT("V"),U,21)'="":$$AMT^DGMTSCU1($P(DGTOT("V"),U,21)),1:"")
44 Q
45 ;
46FLD(DGIN,DGPCE,DGTXT) ;Display inc. fields
47 ; Input:
48 ; DGIN 0 node of #408.21 for vet,spouse, and deps
49 ; DGRPCE as piece
50 ; DGTXT as income desc.
51 ; DGGTOT - If defined keeps running total
52 N DGTOT,I
53 I '$D(DGBL) S $P(DGBL," ",26)=""
54 W:Z'["10" " "
55 W " ",DGTXT,$P(DGBL," ",$L(DGTXT),26)
56 W $J($$AMT^DGMTSCU1($P(DGIN("V"),"^",DGPCE)),10)
57 W " ",$S($D(DGIN("S")):$J($$AMT^DGMTSCU1($P(DGIN("S"),"^",DGPCE)),10),1:$E(DGBL,1,10))
58 W " ",$S($D(DGIN("D")):$J($$AMT^DGMTSCU1($P(DGIN("D"),"^",DGPCE)),11),1:$E(DGBL,1,11))
59 S DGTOT="",I="" F S I=$O(DGIN(I)) Q:I="" I $P(DGIN(I),"^",DGPCE)]"" S DGTOT=DGTOT+$P(DGIN(I),"^",DGPCE)
60 W " ",$J($$AMT^DGMTSCU1(DGTOT),12)
61 I $D(DGGTOT) S DGGTOT=DGGTOT+DGTOT
62 Q
63 ;
64TOT(DGINC,DGDOEXP) ; Totals income
65 ; Input
66 ; DGINC(x,ct) where X is V, S, or D and CT(counter)(per ALL^DGMTU21)
67 ; DGDOEXP: IF =1 TOTAL EXPENSE
68 ;
69 ;Output
70 ; DGTOT(x) where x is V, S, or D and DGTOT(x) = 0 node of #408.21
71 ; (totaled if x is D...total of all deps)
72 ;
73 N DGCT,NODE,PIECE
74 S DGDOEXP=$G(DGDOEXP)
75 S DGTOT("V")=""
76 F DGTYPE="V","S","D" I $D(DGREL(DGTYPE)) S DGTOT(DGTYPE)="" D
77 . S:DGDOEXP&("VS"[DGTYPE) DGEXP(DGTYPE)=$$GET1ND(+$G(DGINC(DGTYPE)))
78 . I "VS"[DGTYPE S DGTOT(DGTYPE)=$$GET0ND(+$G(DGINC(DGTYPE))) Q
79 . F DGCT=0:0 S DGCT=$O(DGINC(DGTYPE,DGCT)) Q:'DGCT D
80 . . S:DGDOEXP DGEXP(DGTYPE)=$$GET1ND(+$G(DGINC(DGTYPE,DGCT)))
81 . . S NODE=$$GET0ND(+DGINC(DGTYPE,DGCT))
82 . . F PIECE=8:1:17 I $P(NODE,"^",PIECE)]"" S $P(DGTOT("D"),"^",PIECE)=$P(DGTOT("D"),"^",PIECE)+$P(NODE,"^",PIECE)
83 Q
84 ;
85GET0ND(IEN) ; Returns the 0 node of File #408.21
86 Q $G(^DGMT(408.21,IEN,0))
87 ;
88GET1ND(IEN) ; Returns the 1 node of file #408.21
89 Q $G(^DGMT(408.21,IEN,1))
90 ;
91MTCHK ; Checks if MT/CP is complete for prior calendar year
92 ; Input:
93 ; DFN
94 ; DGINR array of income relation for deps
95 ; DGISYR as income screening year
96 ;Output:
97 ; DGMTC as MT complete flag (1= yes,2=Non-Mt'd deps exist, 0 o/w)
98 ; DGMTC("S")= Mt complete, but spouse not MTed
99 ; DGMTC("D")= Mt complete, but at least one dep not MT'D
100 ; $D(DGMTED(X,X) if can't edit MT data
101 ;
102 N DGFL,DGHD,DGMTYPT,DGMTCP,I,X
103 S (DGFL,DGMTC)=0 ;initialize flag to 0
104 S DGHD="Income data for "_DGISYR_". "
105 I $P($G(^DGMT(408.21,+$G(DGINC("V")),0)),U,18) S DGHD=DGHD_" [Data Copied - Not Updated]"
106 I '$$MTCOMP^DGRPU(DFN,DGEFDT) W !?(40-($L(DGHD)/2)),DGHD Q ; CP/MT not complete
107 S DGMTCP=$S(DGMTYPT=1:"Means",1:"Copay")
108 S DGMTC=1,DGRPVV(9)="1111111111",DGMTED("V")=1 S DGHD=DGHD_DGMTCP_" Test is complete for that calendar year!"
109 W !?(40-($L(DGHD)/2)),DGHD
110 G:DGEFDT'=DT MTCKQT ;NO EDITING AT ALL FOR LAST YEAR
111 I $D(DGREL("S")) S DGFL=1 I +$G(^DGMT(408.22,+$G(DGINR("S")),"MT")) S DGMTED("S")=1,DGFL=0
112 I DGFL S DGMTC("S")=1 S DGFL=0
113 F I=0:0 S I=$O(DGREL("D",I)) Q:'I S X=+$G(^DGMT(408.22,+$G(DGINR("D",I)),"MT")) S:X DGMTED("D",I)=1 I 'X S DGFL=1
114 I DGFL S DGMTC("D")=1
115 I $D(DGMTC("S"))!$D(DGMTC("D")) W !,*7," You can only edit these items for dependents who are not not "_DGMTCP_" tested!" S DGMTC=2,DGRPVV(9)="0000000000" Q
116 W !,*7,?12,"This data must be edited through the "_DGMTCP_" test module!"
117MTCKQT Q
Note: See TracBrowser for help on using the repository browser.