| 1 | IVMUM2 ;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 | ;
|
|---|
| 5 | EN ; 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 | ;
|
|---|
| 15 | INPIEN ; 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 | ;
|
|---|
| 43 | NOIEN ; 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 | ;
|
|---|
| 67 | ADDDEP ; 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 | ;
|
|---|
| 87 | GETIP ; 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 | ;
|
|---|
| 96 | GETIPI ; 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
|
|---|
