source: WorldVistAEHR/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMCM4.m@ 724

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

initial load of WorldVistAEHR

File size: 1.4 KB
Line 
1IVMCM4 ;ALB/SEK - ADD DCD NEW INDIVIDUAL ANNUAL INCOME FILE ENTRIES ; 02-MAY-95
2 ;;2.0;INCOME VERIFICATION MATCH;**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 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-20
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("DGMT MT/CT UPLOAD ALERTS")
24 .S IVMFERR=""
25 ;
26EN1 ; add 1 node for vet & child
27 ; add 2 node for vet & spouse
28 ;
29 ; - zero node:pieces 8-20
30 F IVMC=3:1:12 S:$P(IVMSEG,"^",IVMC)=HLQ $P(IVMSEG,"^",IVMC)=""
31 S IVM0=$P(IVMSEG,"^",3,12)
32 ;
33 I IVMSPCHV'="S" F IVMC=13:1:15 S:$P(IVMSEG,"^",IVMC)=HLQ $P(IVMSEG,"^",IVMC)=""
34 I IVMSPCHV'="S" S IVM1=$P(IVMSEG,"^",13,15)
35 I IVMSPCHV'="C" F IVMC=16:1:20 S:$P(IVMSEG,"^",IVMC)=HLQ $P(IVMSEG,"^",IVMC)=""
36 I IVMSPCHV'="C" S IVM2=$P(IVMSEG,"^",16,20)
37 S DIK="^DGMT(408.21,"
38 L +^DGMT(408.21,DGINI) S $P(^DGMT(408.21,DGINI,0),"^",8,20)=IVM0,DA=DGINI S:IVMSPCHV'="S" ^(1)=IVM1 S:IVMSPCHV'="C" ^(2)=IVM2
39 D IX1^DIK L -^DGMT(408.21,DGINI)
40 K DA,DIK
41 Q
Note: See TracBrowser for help on using the repository browser.