source: FOIAVistA/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMCM5.m@ 1166

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

initial load of FOIAVistA 6/30/08 version

File size: 4.6 KB
Line 
1IVMCM5 ;ALB/SEK,BRM,CKN - ADD NEW DCD INCOME RELATION FILE ENTRIES ; 2/8/06 2:01pm
2 ;;2.0;INCOME VERIFICATION MATCH;**17,49,105**;21-OCT-94;Build 2
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 inactivate dependents (spouse & children) who are not
7 ; dependents of the test being uploaded, by adding an inactivate
8 ; entry into the EFFECTIVE DATE sub-file (multiple-408.1275) of
9 ; the PATIENT RELATION file (#408.12).
10 ;
11 ; exceptions to above:
12 ; . income screening:
13 ; . "mt" node not set to annual means test ien
14 ; . no replaced test to change primary test for income year
15 ; field to 0
16 ;
17 ;
18 ; DFN Patient file IEN
19 ; DGINI Individual Annual Income IEN
20 ; DGIRI Income Relation IEN
21 ; IVMSEG ZIR record for veteran or spouse or dependent
22 ; IVM0 408.22 0 node pieces 5-7
23 ; IVM01 0 node pieces 9-12
24 ; IVM02 0 node piece 6
25 ; IVM03 0 node piece 18
26 ;
27 N IVM0,IVM01,IVM02,IVM03
28 S DGIRI=$$ADDIR^DGMTU2(DFN,DGINI)
29 ;
30 ; if can't create stub notify site & IVM Center
31 I DGIRI'>0 D Q
32 .S (IVMTEXT(6))="Can't create stub for file 408.22"
33 .D PROB^IVMCMC(IVMTEXT(6))
34 .D ERRBULL^IVMPREC7,MAIL^IVMUFNC("DGMT MT/CT UPLOAD ALERTS")
35 .S IVMFERR=""
36 ;
37 ; set "mt" node to annual means test ien
38 I "^1^2^4^"[("^"_IVMTYPE_"^") D MT^DGMTSCU3(DGIRI,DGMTI)
39 ;
40 Q:IVMSPCHV="S"
41 ;
42 ; set number of dependent children (#.13) and dependent children(#.08)
43 ; in income relation file (#408.22) based on active child dependents
44 ; in patient relation file (#408.12).
45 ; make DCD means test or copay test primary income test for year
46 I IVMSPCHV="V" D Q:$D(IVMFERR)
47 .;
48 .; inactivate dependents who are not dependents of the test
49 .; being uploaded.
50 .K DGREL("V")
51 .I $D(DGREL) D INACTIVE Q:$D(IVMFERR)
52 .;
53 .D RESET^DGMTU11(DFN,DGLY,$S($G(DGMTI):DGMTI,1:0))
54 .I $P($G(^DGMT(408.22,DGIRI,0)),"^",8)="" D
55 ..S DA=DGIRI,DR=".08////0;.13////@",DIE="^DGMT(408.22," D ^DIE
56 ..K DA,DR,DIE
57 .S IVM0=$P(IVMSEG,"^",2,4)
58 I IVMSPCHV="C" S IVM01=$P(IVMSEG,"^",6,9),IVM02=$P(IVMSEG,"^",3),IVM03=$$CONVERT($P(IVMSEG,"^",14),"1/0")
59 S DIK="^DGMT(408.22,"
60 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,$P(^(0),"^",18)=IVM03 S DA=DGIRI D IX1^DIK L -^DGMT(408.22,DGIRI)
61 K DA,DIK
62 Q
63 ;
64INACTIVE ; inactivate dependents not in DCD means test or copay test and
65 ; kill corresponding dgrel
66 N X,Y
67 I $D(DGREL("S")) S DA(1)=+DGREL("S") D K DGREL("S")
68 .D CHKINACT
69 .Q:IVMFLG6!($D(IVMFERR))
70 .; if spouse was active before income year, add record with date
71 .; of 12/31 of year before income year with active code 0
72 .S X=$E(DGLY,1,3)-1_1231
73 .D INACT1
74 Q:'$D(DGREL)!($D(IVMFERR))
75 S IVMACTR=0
76 F S IVMACTR=$O(DGREL("C",IVMACTR)) Q:'IVMACTR S DA(1)=+DGREL("C",IVMACTR) D K DGREL("C",IVMACTR)
77 .D CHKINACT
78 .Q:IVMFLG6!($D(IVMFERR))
79 .; if child was active before income year, add record with date
80 .; of 12/31 of year before income year with active code 0
81 .S X=$E(DGLY,1,3)-1_1231
82 .D INACT1
83 ;
84 K IVMACTR,IVMDGLY,IVMFLG6,IVMYEAR
85 Q
86 ;
87CHKINACT ; if dependent was made active during income year
88 ; add record for same date (add .08 time) with active code 0
89 ;
90 S IVMFLG6=0
91 S IVMDGLY="" F S IVMDGLY=$O(^DGPR(408.12,DA(1),"E","B",IVMDGLY)) Q:IVMDGLY']"" D Q:IVMFLG6!($D(IVMFERR))
92 .Q:$E(IVMDGLY,1,3)'=$E(DGLY,1,3)
93 .S IVMYEAR=0 F S IVMYEAR=$O(^(IVMDGLY,IVMYEAR)) Q:IVMYEAR']"" D Q:IVMFLG6!($D(IVMFERR))
94 ..I $P($G(^DGPR(408.12,DA(1),"E",IVMYEAR,0)),"^",2) D
95 ...S X=IVMDGLY_.08 D INACT1 S IVMFLG6=1
96 ...Q
97 Q
98 ;
99INACT1 ; add inactivate entry to 408.1275
100 ;
101 K DINUM
102 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
103 ;
104 ; if can't create stub notify site & IVM Center
105 I DA'>0 D Q
106 .S (IVMTEXT(6))="Can't create stub for file 408.1275"
107 .D PROB^IVMCMC(IVMTEXT(6))
108 .D ERRBULL^IVMPREC7,MAIL^IVMUFNC("DGMT MT/CT UPLOAD ALERTS")
109 .S IVMFERR=""
110 L +^DGPR(408.12,+DGPRI) S $P(^DGPR(408.12,DA(1),"E",DA,0),"^",2,4)=0_"^"_1_$S(IVMTYPE=3:"",1:"^"_DGMTI) D IX1^DIK L -^DGPR(408.12,+DGPRI)
111 K DA,DIC,DIK
112 Q
113CONVERT(VAL,DATATYPE) ;Data Conversion
114 ; Description: Converts the value found in the HL7 segment to DHCP format
115 ;Input:
116 ; VAL - value parsed from HL7 segment
117 ; DATATYPE - indicates the type of conversion necessary
118 ; "1/0" - "Y"->1,"N"->0
119 ;Currently only one type needs to be converted but new data types can
120 ;be added for other conversion
121 I VAL="" Q VAL
122 I VAL="""""" S VAL="@" Q VAL
123 I ($G(DATATYPE)="1/0") D
124 .I VAL="N" S VAL=0 Q
125 .I VAL="Y" S VAL=1 Q
126 .S VAL=""
127 Q VAL
Note: See TracBrowser for help on using the repository browser.