source: FOIAVistA/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMUM5.m

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

initial load of FOIAVistA 6/30/08 version

File size: 3.7 KB
Line 
1IVMUM5 ;ALB/SEK - ADD NEW INCOME RELATION FILE ENTRIES ; 19 MAY 94
2 ;;2.0;INCOME VERIFICATION MATCH;**1,17**;21-OCT-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EN ; this routine will add entries to INCOME RELATION file (408.22)
6 ; will also inactivate VAMC dependents (spouse & children) who are not
7 ; IVM dependents, by adding an inactivate entry into the EFFECTIVE DATE
8 ; sub-file (multiple-408.1275) of the PATIENT RELATION file (#408.12)
9 ;
10 ; DFN Patient file IEN
11 ; DGINI Individual Annual Income IEN
12 ; DGIRI Income Relation IEN
13 ; IVMSEG ZIR record for veteran or spouse or dependent
14 ; IVM0 408.22 0 node pieces 5-7
15 ; IVM01 0 node pieces 9-12
16 ; IVM02 0 node piece 6
17 ;
18 N IVM0,IVM01,IVM02
19 S DGIRI=$$ADDIR^DGMTU2(DFN,DGINI)
20 ;
21 ; if can't create stub notify site & IVM Center
22 I DGIRI'>0 D Q
23 .S (IVMTEXT(6),HLERR)="Can't create stub for file 408.22"
24 .D ERRBULL^IVMPREC7,MAIL^IVMUFNC()
25 .S IVMFERR=""
26 ;
27 ; set "mt" node to annual means test ien
28 D MT^DGMTSCU3(DGIRI,DGMTI)
29 Q:IVMSPCHV="S"
30 ;
31 ; set number of dependent children (#.13) and dependent children(#.08)
32 ; in income relation file (#408.22) based on active child dependents
33 ; in patient relation file (#408.12).
34 ; make IVM means test primary income test for year
35 I IVMSPCHV="V" D Q:$D(IVMFERR)
36 .S DA=IVMMTIEN,DIE="^DGMT(408.31,",DR="2////0" D ^DIE ; vamc mt
37 .S DA=DGMTI,DIE="^DGMT(408.31,",DR="2////1" D ^DIE ; ivm mt
38 .;
39 .; inactivate VAMC dependents who are not IVM dependents
40 .K DGREL("V")
41 .I $D(DGREL) D INACTIVE Q:$D(IVMFERR)
42 .;
43 .D RESET^DGMTU11(DFN,DGLY,DGMTI)
44 .I $P($G(^DGMT(408.22,DGIRI,0)),"^",8)="" D
45 ..S DA=DGIRI,DR=".08////0;.13////@",DIE="^DGMT(408.22," D ^DIE
46 ..K DA,DR,DIE
47 .S IVM0=$P(IVMSEG,"^",2,4)
48 I IVMSPCHV="C" S IVM01=$P(IVMSEG,"^",6,9),IVM02=$P(IVMSEG,"^",3)
49 S DIK="^DGMT(408.22,"
50 L +^DGMT(408.22,DGIRI) S:IVMSPCHV="V" $P(^DGMT(408.22,DGIRI,0),"^",5,7)=IVM0 S:IVMSPCHV="C" $P(^DGMT(408.22,DGIRI,0),"^",9,12)=IVM01,$P(^(0),"^",6)=IVM02 S DA=DGIRI D IX1^DIK L -^DGMT(408.22,DGIRI)
51 K DA,DIK
52 Q
53 ;
54INACTIVE ; inactivate dependents not in IVM means test and kill
55 ; corresponding dgrel
56 I $D(DGREL("S")) S DA(1)=+DGREL("S") D K DGREL("S")
57 .D CHKINACT
58 .Q:IVMFLG6!($D(IVMFERR))
59 .; if spouse was active before income year, add record with date
60 .; of 12/31 of year before income year with active code 0
61 .S X=$E(DGLY,1,3)-1_1231
62 .D INACT1
63 Q:'$D(DGREL)!($D(IVMFERR))
64 S IVMACTR=0
65 F S IVMACTR=$O(DGREL("C",IVMACTR)) Q:'IVMACTR S DA(1)=+DGREL("C",IVMACTR) D K DGREL("C",IVMACTR)
66 .D CHKINACT
67 .Q:IVMFLG6!($D(IVMFERR))
68 .; if child was active before income year, add record with date
69 .; of 12/31 of year before income year with active code 0
70 .S X=$E(DGLY,1,3)-1_1231
71 .D INACT1
72 ;
73 K IVMACTR,IVMDGLY,IVMFLG6,IVMYEAR
74 Q
75 ;
76CHKINACT ; if dependent was made active during income year
77 ; add record for same date (add .08 time) with active code 0
78 ;
79 S IVMFLG6=0
80 S IVMDGLY="" F S IVMDGLY=$O(^DGPR(408.12,DA(1),"E","B",IVMDGLY)) Q:IVMDGLY']"" D Q:IVMFLG6!($D(IVMFERR))
81 .Q:$E(IVMDGLY,1,3)'=$E(DGLY,1,3)
82 .S IVMYEAR=0 F S IVMYEAR=$O(^(IVMDGLY,IVMYEAR)) Q:IVMYEAR']"" D Q:IVMFLG6!($D(IVMFERR))
83 ..I $P($G(^DGPR(408.12,DA(1),"E",IVMYEAR,0)),"^",2) D
84 ...S X=IVMDGLY_.08 D INACT1 S IVMFLG6=1
85 ...Q
86 Q
87 ;
88INACT1 ; add inactivate entry to 408.1275
89 ;
90 K DINUM
91 S (DIK,DIC)="^DGPR(408.12,DA(1),""E"",",DIC(0)="L",DLAYGO=408.1275 K DD,DO D FILE^DICN S DA=+Y K DLAYGO
92 ;
93 ; if can't create stub notify site & IVM Center
94 I DA'>0 D Q
95 .S (IVMTEXT(6),HLERR)="Can't create stub for file 408.1275"
96 .D ERRBULL^IVMPREC7,MAIL^IVMUFNC()
97 .S IVMFERR=""
98 L +^DGPR(408.12,+DGPRI) S $P(^DGPR(408.12,DA(1),"E",DA,0),"^",2,4)=0_"^"_1_"^"_DGMTI D IX1^DIK L -^DGPR(408.12,+DGPRI)
99 K DA,DIC,DIK
100 Q
Note: See TracBrowser for help on using the repository browser.