source: WorldVistAEHR/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASUM1.m@ 1432

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

initial load of WorldVistAEHR
File size: 6.1 KB
Line 
1EASUM1 ;ALB/SEK,GN - IVM MEANS/COPAY TEST UPLOAD DRIVER ; 7/6/04 1:23pm
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**23,30,35,42**;21-OCT-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;EAS*1*42 add RX Copay to Z06 Upload/Delete
6 ;
7EN ; this routine will call routines to upload means tests sent by the IVM
8 ; Center in HL7 segments. the required sequence of these segments were
9 ; validated in the calling routine IVMPREC7. this routine will call
10 ; IVMUCHK to ensure that the data is consistent with DHCP means test
11 ; file and software requirements.
12 ;
13 ; entries will be added/modified in the following means test and
14 ; patient files:
15 ;
16 ; PATIENT RELATION (#408.12)
17 ; INCOME PERSON (#408.13)
18 ; INDIVIDUAL ANNUAL INCOME (#408.21)
19 ; INCOME RELATION (#408.22)
20 ; ANNUAL MEANS TEST (#408.31)
21 ; MEANS TEST CHANGES (#408.41)
22 ; PATIENT (#2)
23 ;
24 ; current year is date of means test.
25 ; income year is calendar year before date of means test.
26 ; meant test status is based on income year data.
27 ;
28 ; IVMDAP is pointer to the PID HL7 segment in file #772
29 ; IVMDAZ is pointer to the ZMT segment
30 ;
31 S:'$D(DUZ) DUZ=.5 ; if no DUZ set to postmaster
32 ;
33 ; get copay exemption status (IVMCEB) and means test status (IVMMTB)
34 ; before upload
35 S IVMCEB=$P($$RXST^IBARXEU(DFN),"^",2)
36 S IVMMTB=$P($$LST^DGMTU(DFN),"^",3)
37 ;
38 ; subscript of array IVMAR is ien of 408.12 transmitted by IVM Center
39 ; or created by upload.
40 ;K IVMAR
41 ;S IVMX=$$EN^IVMUCHK() I IVMX]"" S HLERR=IVMX K IVMX Q ; error found in MT data
42 ;
43ADD ; add new annual means test file (408.31) stub
44 ; input DGMTDT (.01) dt of test
45 ; DFN (.02) Patient IEN
46 ; DGMTYPT (.19) type of test (1-means test, 2-Rx Copay test)
47 ; output DGMTI annual means test IEN
48 S DGMTDT=IVMMTDT ;stop setting DGMTYPT here, EAS*1*42
49 D ADD^DGMTA
50 I $G(IVMMTIEN)="" S IVMMTIEN=+Y ;Set IEN if only MT on file is Z06 MT
51 ;
52 ;Create new Z06 IVM Means Test
53 ; Make STUB MT primary, add comment that it was created by Edb
54 S DGCOM="Z06 MT via Edb"
55 D PARSEZMT^EASPREC7(ZMTSEG) ;Parse ZMT Segment for MT Data
56 I $$EXPIRED^EASPTRN1(DFN,$G(IVM2)) S DGENUPLD="ENROLLMENT/ELIGIBILITY UPLOAD IN PROGRESS" ;If MT expired then do not update Enrollment record
57 S DA=DGMTI,DIE="^DGMT(408.31,"
58 S DR=".03////^S X=IVM3;.12////^S X=IVM8;.07////^S X=IVM10;.09////^S X=IVM25;.11////^S X=IVM7;.18////^S X=IVM12;.23////^S X=IVM18;.25////^S X=IVM20;2////1;2.02////^S X=IVMDATE;2.03////^S X=IVM26;50///^S X=DGCOM"
59 ;
60 ; Linking logic for MT & CT, conditionally set link field 2.06
61 ; Link the CT to MT (if MT found), or MT to CT (if CT found)
62 ; don't link tests older than Oct. 1999 or not same Year & NOT
63 ; Cat "C" (i.e. Cat "C" & > Oct. 1999 is ok to link)
64 N LNKDAT,LNKMT,LNKDTE,LNKCAT,CURIEN
65 S CURIEN=DGMTI,LNKMT=""
66 S LNKDAT=$$LST^DGMTU(DFN,DGMTDT,$S(DGMTYPT=1:2,1:1)),DGMTI=CURIEN
67 S:LNKDAT LNKMT=+LNKDAT,LNKDTE=$P(LNKDAT,"^",2),LNKCAT=$P(LNKDAT,"^",4)
68 ; set LNKMT off if either of two scenarios below
69 I LNKMT D ;check for < Oct. 1999 1st
70 . I DGMTDT<2991001 S LNKMT="" Q
71 . I $E(LNKDTE,1,3)'=$E(DGMTDT,1,3),LNKCAT'="C" S LNKMT="" Q
72 S:LNKMT DR=DR_";2.06////^S X=LNKMT"
73 ;
74 D ^DIE K DA,DIE,DR ;update new 408.31 test
75 ;
76 ; Update other 408.31 related Test, Link field, if link scenario true
77 I LNKMT S DA=LNKMT,DIE="^DGMT(408.31,",DR="2.06////^S X=CURIEN" D ^DIE K DA,DIE,DR
78 ;
79 ;Variables needed for Bulletins
80 ;
81 S DGCAT=$P($G(^DG(408.32,IVM3,0)),"^",1)
82 I '$D(IVM5) S IVM5=""
83 ;
84 D GETREL^DGMTU11(DFN,"V",DGLY,IVMMTIEN)
85 I EASZ06 S (IVMMT31,DGMTP)=$G(^DGMT(408.31,IVMMTIEN,0)) ;dgmtp is event driver variable
86 D COMPLETE
87 Q
88 ;
89 ; add dependent(s) to income person file (408.13)
90 ;
91 ; add spouse if not in 408.13
92 S IVMSPCHV="S" ; spouse/child/vet indicator
93 S IVMDA1=IVMDAP+3 D GET ; spouse ZDP segment
94 D INPIEN^IVMUM2
95 Q:$D(IVMFERR)
96 ;
97 I IVMFLG5 G ADDCHILD ; entry not added - goto add children
98 ;
99 ; add entry to patient relation file (408.12)
100 D EN^IVMUM3
101 Q:$D(IVMFERR)
102 ;
103ADDS21 ; add spouse entry to individual annual income file (408.21)
104 S IVMDA1=IVMDAP+4 D GET ; spouse ZIC segment
105 D EN^IVMUM4
106 Q:$D(IVMFERR)
107 ;
108 ; add spouse entry to income relation file (408.22)
109 S IVMDA1=IVMDAP+5 D GET ; spouse ZIR segment
110 D EN^IVMUM5
111 Q:$D(IVMFERR)
112 ;
113ADDCHILD ; add children if not in 408.13
114 S IVMSPCHV="C" ; spouse/child/vet indicator
115 I 'IVMFLGC G ADDV21 ; no dependent children
116 S IVMCTR2=5
117 F IVMCTR3=1:1:IVMFLGC D Q:$D(IVMFERR)
118 .S IVMCTR2=IVMCTR2+1
119 .S IVMDA1=IVMDAP+IVMCTR2 D GET ; child ZDP segment
120 .D INPIEN^IVMUM2
121 .Q:$D(IVMFERR)
122 .;
123 .; add child entry to patient relation file (408.12)
124 .D EN^IVMUM3
125 .Q:$D(IVMFERR)
126 .;
127ADDC21 .; add child entry to individual annual income file (408.21)
128 .S IVMCTR2=IVMCTR2+1
129 .S IVMDA1=IVMDAP+IVMCTR2 D GET ; child ZIC segment
130 .D EN^IVMUM4
131 .Q:$D(IVMFERR)
132 .;
133 .; add entry to income relation file (408.22)
134 .S IVMCTR2=IVMCTR2+1
135 .S IVMDA1=IVMDAP+IVMCTR2 D GET ; child ZIR segment
136 .D EN^IVMUM5
137 .Q:$D(IVMFERR)
138 .Q
139 Q:$D(IVMFERR)
140 ;
141ADDV21 ; add vet entry to individual annual income file (408.21)
142 ; get vet patient relation ien
143 S DGPRI=+$G(DGREL("V"))
144 S IVMDA1=IVMDAP+1 D GET ; vet ZIC segment
145 S IVMSPCHV="V" ; spouse/child/vet indicator
146 D EN^IVMUM4
147 Q:$D(IVMFERR)
148 S DGVINI=DGINI ; vet individual annual income ien
149 ;
150 ; add vet entry to income relation file (408.22)
151 S IVMDA1=IVMDAP+2 D GET ; vet ZIR segment
152 D EN^IVMUM5
153 Q:$D(IVMFERR)
154 S DGVIRI=DGIRI ; vet income relation ien
155 ;
156COMPLETE ; complete means test
157 ;
158 ;D EN^IVMUM6
159 ;Call Means Test Event Driver to complete processing
160 ;
161 S DGMTACT="UPL"
162 D AFTER^DGMTEVT
163 S DGMTINF=1 ;Non-Interactive Flag
164 D EN^DGMTEVT
165 D MTBULL^EASUM7,MAIL^IVMUFNC() ;Build Mail Message
166 ;
167 ; cleanup ;EAS*1*42 remove Dgmtypt
168 K DGINI,DGIRI,DGLY,DGMTDT,DGPRI,DGREL,DGVINI,DGVIRI,DGENUPLD
169 K DGCAT,IVMAR,IVMCEB,IVMCTR2,IVMCTR3,IVMDA1,IVMDAP,IVMFERR
170 K IVMFLG2,IVMFLG5,IVMFLGC,IVMMTB,IVMPRN
171 K IVMRELN,IVMRELO,IVMSEG,IVMSPCHV,IVMX
172 Q
173 ;
174GET ; get HL7 segment from ^HL
175 S IVMSEG=$P($G(^TMP($J,IVMRTN,IVMDA1,0)),"^",2,999)
176 Q
Note: See TracBrowser for help on using the repository browser.