| [613] | 1 | IVMUM4 ;ALB/SEK - ADD NEW INDIVIDUAL ANNUAL INCOME FILE ENTRIES ; 19 MAY 94
|
|---|
| 2 | ;;2.0;INCOME VERIFICATION MATCH;**1,8,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 INDIVIDUAL ANNUAL INCOME file
|
|---|
| 6 | ; (408.21)
|
|---|
| 7 | ;
|
|---|
| 8 | ; DFN Patient file IEN
|
|---|
| 9 | ; DGPRI Patient Relation IEN
|
|---|
| 10 | ; DGLY Last Year
|
|---|
| 11 | ; DGINI New Individual Annual Income IEN
|
|---|
| 12 | ; IVMSEG ZIC record for veteran or spouse or dependent
|
|---|
| 13 | ; IVM0 408.21 0 node pieces 8-18
|
|---|
| 14 | ; IVM1 1 node pieces 1-3
|
|---|
| 15 | ; IVM2 2 node pieces 1-5
|
|---|
| 16 | ;
|
|---|
| 17 | N IVM0,IVM1,IVM2,IVMC
|
|---|
| 18 | S DGINI=$$ADDIN^DGMTU2(DFN,DGPRI,DGLY)
|
|---|
| 19 | ;
|
|---|
| 20 | ; if can't create stub notify site & IVM Center
|
|---|
| 21 | I DGINI'>0 D Q
|
|---|
| 22 | .S (IVMTEXT(6),HLERR)="Can't create stub for file 408.21"
|
|---|
| 23 | .D ERRBULL^IVMPREC7,MAIL^IVMUFNC()
|
|---|
| 24 | .S IVMFERR=""
|
|---|
| 25 | ;
|
|---|
| 26 | EN1 ; add 1 node for vet & child
|
|---|
| 27 | ; add 2 node for vet & spouse
|
|---|
| 28 | F IVMC=3:1:12 S:$P(IVMSEG,"^",IVMC)=HLQ $P(IVMSEG,"^",IVMC)=""
|
|---|
| 29 | S IVM0=$P(IVMSEG,"^",3,12)
|
|---|
| 30 | I IVMSPCHV'="S" F IVMC=13:1:15 S:$P(IVMSEG,"^",IVMC)=HLQ $P(IVMSEG,"^",IVMC)=""
|
|---|
| 31 | I IVMSPCHV'="S" S IVM1=$P(IVMSEG,"^",13,15)
|
|---|
| 32 | I IVMSPCHV'="C" F IVMC=16:1:20 S:$P(IVMSEG,"^",IVMC)=HLQ $P(IVMSEG,"^",IVMC)=""
|
|---|
| 33 | I IVMSPCHV'="C" S IVM2=$P(IVMSEG,"^",16,20)
|
|---|
| 34 | S DIK="^DGMT(408.21,"
|
|---|
| 35 | L +^DGMT(408.21,DGINI) S $P(^DGMT(408.21,DGINI,0),"^",8,17)=IVM0,DA=DGINI S:IVMSPCHV'="S" ^(1)=IVM1 S:IVMSPCHV'="C" ^(2)=IVM2 D IX1^DIK L -^DGMT(408.21,DGINI)
|
|---|
| 36 | K DA,DIK
|
|---|
| 37 | Q
|
|---|
