source: FOIAVistA/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMUM1.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.0 KB
Line 
1IVMUM1 ;ALB/SEK - MEANS TEST UPLOAD DRIVER ; 3/6/01 5:13pm
2 ;;2.0;INCOME VERIFICATION MATCH;**1,8,34**;21-OCT-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EN ; this routine will call routines to upload means tests sent by the IVM
6 ; Center in HL7 segments. the required sequence of these segments were
7 ; validated in the calling routine IVMPREC7. this routine will call
8 ; IVMUCHK to ensure that the data is consistent with DHCP means test
9 ; file and software requirements.
10 ;
11 ; entries will be added/modified in the following means test and
12 ; patient files:
13 ;
14 ; PATIENT RELATION (#408.12)
15 ; INCOME PERSON (#408.13)
16 ; INDIVIDUAL ANNUAL INCOME (#408.21)
17 ; INCOME RELATION (#408.22)
18 ; ANNUAL MEANS TEST (#408.31)
19 ; MEANS TEST CHANGES (#408.41)
20 ; PATIENT (#2)
21 ;
22 ; current year is date of means test.
23 ; income year is calendar year before date of means test.
24 ; meant test status is based on income year data.
25 ;
26 ; IVMDAP is pointer to the PID HL7 segment in file #772
27 ; IVMDAZ is pointer to the ZMT segment
28 ;
29 S:'$D(DUZ) DUZ=.5 ; if no DUZ set to postmaster
30 ;
31 ; get copay exemption status (IVMCEB) and means test status (IVMMTB)
32 ; before upload
33 S IVMCEB=$P($$RXST^IBARXEU(DFN),"^",2)
34 S IVMMTB=$P($$LST^DGMTU(DFN),"^",3)
35 ;
36 ; subscript of array IVMAR is ien of 408.12 transmitted by IVM Center
37 ; or created by upload.
38 K IVMAR
39 S IVMX=$$EN^IVMUCHK() I IVMX]"" S HLERR=IVMX K IVMX Q ; error found in MT data
40 ;
41ADD ; add new annual means test file (408.31) stub
42 ; input DGMTDT (.01) dt of test
43 ; DFN (.02) Patient IEN
44 ; DGMTYPT (.19) type of test (1-means test)
45 ; output DGMTI annual means test IEN
46 S DGMTDT=IVMMTDT,DGMTYPT=1
47 D ADD^DGMTA
48 ;
49 ; change primary income test for year? code from 1 to 0 for
50 ; IVM means test.
51 S DA=DGMTI,DIE="^DGMT(408.31,",DR="2////0"
52 D ^DIE K DA,DIE,DR
53 ;
54 D GETREL^DGMTU11(DFN,"VSC",DGLY,IVMMTIEN)
55 ;
56 ; add dependent(s) to income person file (408.13)
57 ;
58 ; add spouse if not in 408.13
59 S IVMSPCHV="S" ; spouse/child/vet indicator
60 S IVMDA1=IVMDAP+3 D GET ; spouse ZDP segment
61 D INPIEN^IVMUM2
62 Q:$D(IVMFERR)
63 ;
64 I IVMFLG5 G ADDCHILD ; entry not added - goto add children
65 ;
66 ; add entry to patient relation file (408.12)
67 D EN^IVMUM3
68 Q:$D(IVMFERR)
69 ;
70ADDS21 ; add spouse entry to individual annual income file (408.21)
71 S IVMDA1=IVMDAP+4 D GET ; spouse ZIC segment
72 D EN^IVMUM4
73 Q:$D(IVMFERR)
74 ;
75 ; add spouse entry to income relation file (408.22)
76 S IVMDA1=IVMDAP+5 D GET ; spouse ZIR segment
77 D EN^IVMUM5
78 Q:$D(IVMFERR)
79 ;
80ADDCHILD ; add children if not in 408.13
81 S IVMSPCHV="C" ; spouse/child/vet indicator
82 I 'IVMFLGC G ADDV21 ; no dependent children
83 S IVMCTR2=5
84 F IVMCTR3=1:1:IVMFLGC D Q:$D(IVMFERR)
85 .S IVMCTR2=IVMCTR2+1
86 .S IVMDA1=IVMDAP+IVMCTR2 D GET ; child ZDP segment
87 .D INPIEN^IVMUM2
88 .Q:$D(IVMFERR)
89 .;
90 .; add child entry to patient relation file (408.12)
91 .D EN^IVMUM3
92 .Q:$D(IVMFERR)
93 .;
94ADDC21 .; add child entry to individual annual income file (408.21)
95 .S IVMCTR2=IVMCTR2+1
96 .S IVMDA1=IVMDAP+IVMCTR2 D GET ; child ZIC segment
97 .D EN^IVMUM4
98 .Q:$D(IVMFERR)
99 .;
100 .; add entry to income relation file (408.22)
101 .S IVMCTR2=IVMCTR2+1
102 .S IVMDA1=IVMDAP+IVMCTR2 D GET ; child ZIR segment
103 .D EN^IVMUM5
104 .Q:$D(IVMFERR)
105 .Q
106 Q:$D(IVMFERR)
107 ;
108ADDV21 ; add vet entry to individual annual income file (408.21)
109 ; get vet patient relation ien
110 S DGPRI=+$G(DGREL("V"))
111 S IVMDA1=IVMDAP+1 D GET ; vet ZIC segment
112 S IVMSPCHV="V" ; spouse/child/vet indicator
113 D EN^IVMUM4
114 Q:$D(IVMFERR)
115 S DGVINI=DGINI ; vet individual annual income ien
116 ;
117 ; add vet entry to income relation file (408.22)
118 S IVMDA1=IVMDAP+2 D GET ; vet ZIR segment
119 D EN^IVMUM5
120 Q:$D(IVMFERR)
121 S DGVIRI=DGIRI ; vet income relation ien
122 ;
123COMPLETE ; complete means test
124 ;
125 D EN^IVMUM6
126 ;
127 ; cleanup
128 K DGINI,DGIRI,DGLY,DGMTDT,DGMTYPT,DGPRI,DGREL,DGVINI,DGVIRI
129 K IVMAR,IVMCEB,IVMCTR2,IVMCTR3,IVMDA1,IVMDAP,IVMFERR
130 K IVMFLG2,IVMFLG5,IVMFLGC,IVMMTB,IVMMTDT,IVMMTIEN,IVMPRN
131 K IVMRELN,IVMRELO,IVMSEG,IVMSPCHV,IVMX
132 Q
133 ;
134GET ; get HL7 segment from ^HL
135 S IVMSEG=$P($G(^TMP($J,IVMRTN,IVMDA1,0)),"^",2,999)
136 Q
Note: See TracBrowser for help on using the repository browser.