source: WorldVistAEHR/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMUM2.m@ 975

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

initial load of WorldVistAEHR
File size: 4.0 KB
Line 
1IVMUM2 ;ALB/SEK - ADD NEW DEPENDENT TO INCOME PERSON FILE ; 12 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 PERSON file (408.13) for
6 ; new dependents (spouse/children). if IVM demo data (name, dob,
7 ; ssn, sex) is different than VAMC data, 408.13 will be changed to
8 ; contain the IVM data. the MEANS TEST CHANGES file (408.41) will
9 ; contain both values.
10 ;
11 ; current year is date of means test.
12 ; income year is calendar year before date of means test.
13 ; meant test status is based on income year data.
14 ;
15INPIEN ; get INCOME PERSON IEN
16 ; if PATIENT RELATION IEN not in ZDP
17 ; add dependent to INCOME PERSON file if dependent not found
18 ; dependent found if dob, sex, & relationship (408.12) match
19 ;
20 ; Input DFN IEN of file #2
21 ; IVMSEG dependent's ZDP segment
22 ;
23 ; ivmflg1=1 have 408.13 ien when exit (found or added)
24 ; ivmflg2=1 dep record must be added to 408.12
25 ; ivmflg5=1 spouse ZDP incomplete(not dependent) - always spouse records
26 S (IVMFLG1,IVMFLG2,IVMFLG5)=0
27 S DGPRI=$P(IVMSEG,"^",7) ; ien of patient relation file
28 ;
29 S IVMNM=$$FMNAME^HLFNC($P(IVMSEG,"^",2)),IVMSEX=$P(IVMSEG,"^",3),IVMDOB=$$FMDATE^HLFNC($P(IVMSEG,"^",4)),IVMSSN=$P(IVMSEG,"^",5)
30 S IVMEFFDT=$$FMDATE^HLFNC($P(IVMSEG,"^",9)),IVMRELN=$P(IVMSEG,"^",6)
31 ;
32 I IVMSPCHV="S"&((IVMNM']"")!(IVMSEX']"")!(IVMDOB']"")) S IVMFLG5=1 Q
33 I 'DGPRI G NOIEN
34 ;
35 ; if ien of patient relation file (dgpri) transmitted by IVM Center
36 ; and found in 408.12, get ien of income person. if IVM demo data
37 ; is different, change in 408.13 & add to 408.41
38 ; ivmprn is 0 node of 408.12
39 ; dgipi is ien of 408.13
40 S IVMPRN=$G(^DGPR(408.12,+DGPRI,0))
41 I IVMPRN]"" D GETIPI Q:$D(IVMFERR) S DGIPI=+$P($P(IVMPRN,"^",3),";"),IVMFLG1=1,IVMRELO=$P(IVMPRN,"^",2) D AUDITP^IVMUM9,AUDIT^IVMUM9 Q
42 ;
43NOIEN ; ien of patient relation file is not transmitted or transmitted and
44 ; not found
45 ; check if dependent in income person file
46 ; if dependent not found in 408.13, setup ivmstr = 0 node of 408.13
47 ; subscript of array IVMAR is ien of 408.12 transmitted by IVM Center or
48 ; created or found by upload.
49 ;
50 S DGPRI=0 F S DGPRI=$O(^DGPR(408.12,"B",DFN,DGPRI)) Q:'DGPRI D Q:IVMFLG1!($D(IVMFERR))
51 .D GETIP
52 .Q:$D(IVMFERR)!($D(IVMAR(DGPRI)))!(IVMRELO=1)
53 .I IVMSEX=IVMSEX13&(IVMDOB=IVMDOB13)&(IVMRELN=IVMRELO) S IVMFLG1=1,IVMAR(DGPRI)=""
54 .Q
55 ;
56 ; found dependent in 408.13. if demo data different, change in 408.13
57 ; and add in 408.41
58 Q:$D(IVMFERR)
59 I IVMFLG1 S DGIPI=+$P($P(IVMPRN,"^",3),";") D AUDITP^IVMUM9,AUDIT1^IVMUM9 Q
60 ;
61 ; dependent not found. add record to 408.13
62 I 'IVMFLG1 D
63 .S $P(IVMSTR,"^")=IVMNM,$P(IVMSTR,"^",2)=IVMSEX,$P(IVMSTR,"^",3)=IVMDOB,$P(IVMSTR,"^",9)=IVMSSN
64 .D ADDDEP
65 Q
66 ;
67ADDDEP ; add dependent to 408.13 file
68 ; In - DFN=IEN of File #2
69 ; DGRP0ND=0 node of 408.13
70 ;Out - DGIPI=408.13 IEN
71 ;
72 S DGRP0ND=IVMSTR
73 K DINUM
74 S (DIK,DIC)="^DGPR(408.13,",DIC(0)="L",DLAYGO=408.13,X=$P(DGRP0ND,"^") K DD,DO D FILE^DICN S (DGIPI,DA)=+Y K DLAYGO
75 ;
76 ; if can't create stub notify site & IVM Center
77 I DGIPI'>0 D Q
78 .S (IVMTEXT(6),HLERR)="Can't create stub for file 408.13"
79 .D ERRBULL^IVMPREC7,MAIL^IVMUFNC()
80 .S IVMFERR=""
81 L +^DGPR(408.13,+DGIPI) S ^DGPR(408.13,+DGIPI,0)=DGRP0ND D IX1^DIK L -^DGPR(408.13,+DGIPI)
82 S IVMFLG2=1 ; added dep to 408.13 must add to 408.12
83 K DIK,DIC
84 Q
85 ;
86 ;
87GETIP ; if can't find 408.12 record notify site & IVM Center
88 S IVMPRN=$G(^DGPR(408.12,+DGPRI,0))
89 S IVMRELO=$P(IVMPRN,"^",2)
90 I IVMPRN']"" D Q
91 .S (IVMTEXT(6),HLERR)="Can't find 408.12 record "_DGPRI
92 .D ERRBULL^IVMPREC7,MAIL^IVMUFNC()
93 .S IVMFERR=""
94 Q:IVMRELO=1
95 ;
96GETIPI ; ivmseg13 is 0 node of income person file
97 ; get demo data in 408.13 & 408.12
98 S IVMSEG13=$$DEM^DGMTU1(DGPRI)
99 I IVMSEG13']"" D Q
100 .S (IVMTEXT(6),HLERR)="Can't find 408.13 record"
101 .D ERRBULL^IVMPREC7,MAIL^IVMUFNC()
102 .S IVMFERR=""
103 S IVMSEX13=$P(IVMSEG13,"^",2),IVMDOB13=$P(IVMSEG13,"^",3),IVMSSN13=$P(IVMSEG13,"^",9)
104 S IVMNM13=$P(IVMSEG13,"^")
105 Q
Note: See TracBrowser for help on using the repository browser.