source: FOIAVistA/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMUM6.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 4.7 KB
Line 
1IVMUM6 ;ALB/SEK - COMPLETE MEANS TEST ; 23 MAY 94
2 ;;2.0;INCOME VERIFICATION MATCH;**1,3,17**;21-OCT-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EN ; this routine will call MAS routines to determine the following:
6 ; total dependents
7 ; income
8 ; net worth
9 ; deductible expenses
10 ; thresholds
11 ; category
12 ;
13 ; the above will be added in the ANNUAL MEANS TEST file(#408.31)
14 ;
15 ; s dgcomf=1 to indicate completing means test which will update
16 ; means test ien (field 31) in individual annual income file (408.21)
17 ; when called SET^DGMTSCU2
18 S DGCOMF=1
19 ;
20 ; get DGMTPAR - annual means test parameters 0 node from ^DG(43,1,"MT"
21 ; if current year parameters are not available DGMTPAR will contain
22 ; previous year income parameters and DGMTPAR("PREV") will be defined
23 ; indicating such.
24 D PAR^DGMTSCU
25 ;
26 ; d set^dgmtscu2 will create the following variables to update
27 ; annual means test file (408.31):
28 ; dgmts - means test status(.03)
29 ; dgint - income(.04)
30 ; dgnwt - net worth(.05)
31 ; dgtha - threshold a(.12)
32 ; dgthb - threshold b(.13)
33 ; dgdet - deductible expenses(.15)
34 ; dgmtpar("prev") - previous years threshold(.16) (if defined)
35 ; dgnd - total dependents(.18)
36 ;
37 D SET^DGMTSCU2
38 ;
39 ; setup other variables for 408.31
40 S IVMDA1=IVMDAZ D GET^IVMUM1 ; get ZMT segment
41 S IVM1=$$FMDATE^HLFNC($P(IVMSEG,"^",10)) ; dt/time completed
42 S IVM2=$P(IVMSEG,"^",7) ; agree to pay deductible
43 S IVM3=$$FMDATE^HLFNC($P(IVMSEG,"^",15)) ; dt verified test sign
44 S IVM4=$P(IVMSEG,"^",16) ; declines to give income info field
45 S IVM5=$$FMDATE^HLFNC($P(IVMSEG,"^",6)) ; dt/time of adjudication
46 S IVM6=$$FMDATE^HLFNC($P(IVMSEG,"^",20)) ; dt ivm verified mt completed
47 S IVM7=$P(IVMSEG,"^",21) ; refuse to sign
48 S IVMSTAT=$P(IVMSEG,"^",3) ; means test status
49 ;
50 I IVM4 S DGCAT="C" D STA^DGMTSCU2 ; make cat C if declines to give income info
51 ;
52 I DGTYC="M",(DGNWT+DGINT-DGDET)>$P(DGMTPAR,"^",8) S DGCAT="C" D STA^DGMTSCU2 ; if cat A for income make cat C if high assets
53 ;
54 ; add to annual means test file
55 S:'$D(DGTHB) DGTHB=""
56 S DA=DGMTI,DIE="^DGMT(408.31,"
57 S DR=".03////^S X=DGMTS;.04////^S X=DGINT;.05////^S X=DGNWT;.06////^S X=DUZ;.07////^S X=IVM1;.11////^S X=IVM2;.12////^S X=DGTHA;.13////^S X=DGTHB;.14////^S X=IVM4;.15////^S X=DGDET;.18////^S X=DGND;.23////2;.24////^S X=IVM3"
58 I $D(DGMTPAR("PREV")) S DR=DR_";.16////1"
59 D ^DIE K DR
60 S DR=".1////^S X=IVM5;.25////^S X=IVM6;.26////^S X=IVM7"
61 D ^DIE K DA,DIE,DR
62 ;
63 ; if ivm mt cat diff then calculated cat or still cat a ack msg is
64 ; sent to ivm center
65 ; dgcat (mt cat) is also created by d set^dgmtscu2
66 I IVMSTAT'=DGCAT D G MTDRIVER
67 .S HLERR="Uploaded mt cat should be "_DGCAT
68 I DGCAT="A" D
69 .S HLERR="Uploaded mt cat is still A"
70 ;
71MTDRIVER ; call means test event driver
72 S DGMTACT="UPL"
73 D AFTER^DGMTEVT
74 S DGMTINF=1 ; non-interactive flag
75 D EN^DGMTEVT
76 ;
77 ; close IVM case record for patient
78 D CLOSE^IVMPTRN1(DGLY,DFN,1,1)
79 ;
80 ; Get copay exemption status (IVMCEA) and means test status (IVMMTA
81 ; after upload. If different from before upload and send notification
82 ; mail message to the site. Also, send notification mail message if
83 ; patient doesn't agree to pay deductible.
84 S IVMCNTR=10
85 S IVMCEA=$P($$RXST^IBARXEU(DFN),"^",2)
86 I IVMCEA'=IVMCEB D
87 .S IVMTEXT(10)=""
88 .S IVMTEXT(11)="The patient is now "_IVMCEA_" from the prescription copayment."
89 .S IVMCNTR=12
90 S IVMMTA=$P($$LST^DGMTU(DFN),"^",3)
91 I IVMMTA'=IVMMTB D
92 .S IVMTEXT(IVMCNTR)=""
93 .S IVMTEXT(IVMCNTR+1)="The patient's current Means Test status is now "_IVMMTA_"."
94 .S IVMCNTR=IVMCNTR+2
95 I 'IVM2 D
96 .S IVMTEXT(IVMCNTR)=""
97 .I IVM2=0 D Q
98 ..S IVMTEXT(IVMCNTR+1)="The patient is CATEGORY C and doesn't agree to pay the deductible."
99 .S IVMTEXT(IVMCNTR+1)="The patient is CATEGORY C and didn't answer agree to pay the deductible."
100 D MTBULL,MAIL^IVMUFNC()
101 ;
102 ; cleanup
103 K DGCAT,DGCOMF,DGMTACT,DGMTI,DGMTINF,DGMTPAR,DGTHB
104 K IVM1,IVM2,IVM3,IVM4,IVM5,IVM6,IVM7,IVMCEA,IVMCEB,IVMMTA
105 Q
106 ;
107MTBULL ; build mail message for transmission to IVM mail group notifying them
108 ; an IVM verified means test has been uploaded into DHCP for a patient.
109 ;
110 S IVMPAT=$$PT^IVMUFNC4(DFN)
111 S XMSUB="IVM - MEANS TEST UPLOAD for "_$P($P(IVMPAT,"^"),",")_" ("_$P(IVMPAT,"^",3)_")"
112 S IVMTEXT(1)="An Income Verification Match verified Means Test has been uploaded"
113 S IVMTEXT(2)="for the following patient:"
114 S IVMTEXT(3)=" "
115 S IVMTEXT(4)=" NAME: "_$P(IVMPAT,"^")
116 S IVMTEXT(5)=" ID: "_$P(IVMPAT,"^",2)
117 S Y=IVMMTDT X ^DD("DD")
118 S IVMTEXT(6)=" DATE OF TEST: "_Y
119 S IVMTEXT(7)=" PREV CATEGORY: "_$P($G(^DG(408.32,+$P(IVMMT31,"^",3),0)),"^",2)
120 S IVMTEXT(8)=" NEW CATEGORY: "_DGCAT
121 I IVM5 S Y=IVM5 X ^DD("DD") S IVMTEXT(9)=" DATE/TIME OF ADJUDICATION: "_Y
122 Q
Note: See TracBrowser for help on using the repository browser.