| 1 | IVMUM1 ;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 |  ;
 | 
|---|
| 5 | EN ; 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 |  ;
 | 
|---|
| 41 | ADD ; 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 |  ;
 | 
|---|
| 70 | ADDS21 ; 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 |  ;
 | 
|---|
| 80 | ADDCHILD ; 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 |  .;
 | 
|---|
| 94 | ADDC21 .; 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 |  ;
 | 
|---|
| 108 | ADDV21 ; 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 |  ;
 | 
|---|
| 123 | COMPLETE ; 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 |  ; 
 | 
|---|
| 134 | GET ; get HL7 segment from ^HL
 | 
|---|
| 135 |  S IVMSEG=$P($G(^TMP($J,IVMRTN,IVMDA1,0)),"^",2,999)
 | 
|---|
| 136 |  Q
 | 
|---|