source: FOIAVistA/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMUM8.m@ 1790

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

initial load of FOIAVistA 6/30/08 version

File size: 2.7 KB
Line 
1IVMUM8 ;ALB/SEK - DELETE IVM MEANS TEST (CON'T) ; 13 JAN 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 ; change demo data in 408.12 & 408.13 back to VAMC values
6 ; ivm12 408.12 ien
7 ; ivm13 408.13 ien
8 ; ivmmtien 408.31 ien
9 ;
10 ; note: 408.13 fields were added to 408.41 before 408.12 field
11 ;
12 K DR S IVM41=0
13 F S IVM41=$O(^DGMT(408.41,"D",IVMMTIEN,IVM41)) Q:'IVM41 D
14 .S IVM411=$G(^DGMT(408.41,+IVM41,0))
15 .Q:$P(IVM411,"^",10)'=IVM13
16 .S IVMOLD=$P(IVM411,"^",5)
17 .S IVMOLD=$S(IVMOLD="":"@",1:IVMOLD)
18 .S IVMFILE=$P(IVMAR1($P(IVM411,"^",2)),";")
19 .S IVMNOD=$P(IVMAR1($P(IVM411,"^",2)),";",2)
20 .I IVMFILE=408.13 S DA=IVM13,DIE="^DGPR(408.13,"
21 .I IVMFILE=408.12 S DA=IVM12,DIE="^DGPR(408.12,"
22 .S DR=IVMNOD_"////^S X=IVMOLD" D ^DIE K DA,DR,DIE
23 .Q
24 Q
25 ;
26EN1 ; change primary income test for year? code from 0 to 1 for VAMC MT
27 S DA=IVMVAMC,DIE="^DGMT(408.31,",DR="2////1" D ^DIE K DA,DIE,DR
28 ;
29 ; delete 408.31
30 ;
31 S DA=IVMMTIEN,DIK="^DGMT(408.31," D ^DIK
32 ;
33 ; open IVM case record which was closed during upload
34 S DA=$O(^IVM(301.5,"APT",+DFN,+DGLY,0))
35 I $G(^IVM(301.5,+DA,0))']"" G MTBULL
36 S DR=".04////0",DIE="^IVM(301.5," D ^DIE
37 K ^IVM(301.5,DA,1)
38 ;
39MTBULL ; build and transmit mail message to IVM mail group notifying site
40 ; that a means test was deleted.
41 S IVMPAT=$$PT^IVMUFNC4(DFN)
42 S XMSUB="IVM - MEANS TEST DELETED"
43 S IVMTEXT(1)="An Income Verification Match Means Test was deleted for the"
44 S IVMTEXT(2)="following patient:"
45 S IVMTEXT(3)=" "
46 S IVMTEXT(4)=" NAME: "_$P(IVMPAT,"^")
47 S IVMTEXT(5)=" ID: "_$P(IVMPAT,"^",2)
48 S Y=IVMMTDT X ^DD("DD")
49 S IVMTEXT(6)=" DATE OF TEST: "_Y
50 S IVMTEXT(7)=" "
51 S IVMTEXT(8)="NOTE: The original DHCP Means Test is now the primary Means Test."
52 D MAIL^IVMUFNC()
53 ;
54 ; call event driver
55 S DGMTINF=1,DGMTP=IVMNO,DGMTA=IVMVNO
56 S DGMTACT="DUP",DGMTI=IVMVAMC D EN^DGMTEVT
57 S DGMTACT="DEL",DGMTI=IVMMTIEN D EN^DGMTEVT
58 ;
59 ; cleanup
60 K DA,DFN,DGINC,DGINR,DGLY,DGMTA,DGMTACT,DGMTI,DGMTINF,DGMTP
61 K DIE,DIK,DR,IVM12,IVM121,IVM13,IVM41,IVM411,IVMFILE
62 K IVMFLGC,IVMMTDT,IVMMTIEN,IVMN,IVMNO,IVMNOD,IVMOLD
63 K IVMPAT,IVMSOT,IVMTEXT,IVMVAMC,IVMVAMCA,IVMVNO,XMSUB,Y
64 Q
65 ;
66SETUPAR ; create array ivmar1
67 ; subscript is 408.42 node (type of change - name, dob, ssn, sex, relationship)
68 ; 1st piece is file 408.12 or 408.13
69 ; 2nd piece is 408.12 or 408.13 field #
70 F IVM41=4:1 S IVM411=$P($T(TYPECH+IVM41),";;",2) Q:IVM411="QUIT" D
71 .S IVMAR1($P(IVM411,";"))=$P(IVM411,";",2,3)
72 K IVM41,IVM411
73 Q
74 ;
75TYPECH ; type of dependent changes 408.41/408.42
76 ; 1st piece - 408.42 table file node
77 ; 2nd piece - file (408.12/408.13)
78 ; 3rd piece - 408.12/408.13 field
79 ;;16;408.13;.01
80 ;;17;408.13;.03
81 ;;18;408.13;.09
82 ;;19;408.13;.02
83 ;;20;408.12;.02
84 ;;QUIT
Note: See TracBrowser for help on using the repository browser.