Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IVMUM1

IVMUM1.m

Go to the documentation of this file.
  1. IVMUM1 ;ALB/SEK - MEANS TEST UPLOAD DRIVER ; 3/6/01 5:13pm
  1. ;;2.0;INCOME VERIFICATION MATCH;**1,8,34**;21-OCT-94
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. EN ; this routine will call routines to upload means tests sent by the IVM
  1. ; Center in HL7 segments. the required sequence of these segments were
  1. ; validated in the calling routine IVMPREC7. this routine will call
  1. ; IVMUCHK to ensure that the data is consistent with DHCP means test
  1. ; file and software requirements.
  1. ;
  1. ; entries will be added/modified in the following means test and
  1. ; patient files:
  1. ;
  1. ; PATIENT RELATION (#408.12)
  1. ; INCOME PERSON (#408.13)
  1. ; INDIVIDUAL ANNUAL INCOME (#408.21)
  1. ; INCOME RELATION (#408.22)
  1. ; ANNUAL MEANS TEST (#408.31)
  1. ; MEANS TEST CHANGES (#408.41)
  1. ; PATIENT (#2)
  1. ;
  1. ; current year is date of means test.
  1. ; income year is calendar year before date of means test.
  1. ; meant test status is based on income year data.
  1. ;
  1. ; IVMDAP is pointer to the PID HL7 segment in file #772
  1. ; IVMDAZ is pointer to the ZMT segment
  1. ;
  1. S:'$D(DUZ) DUZ=.5 ; if no DUZ set to postmaster
  1. ;
  1. ; get copay exemption status (IVMCEB) and means test status (IVMMTB)
  1. ; before upload
  1. S IVMCEB=$P($$RXST^IBARXEU(DFN),"^",2)
  1. S IVMMTB=$P($$LST^DGMTU(DFN),"^",3)
  1. ;
  1. ; subscript of array IVMAR is ien of 408.12 transmitted by IVM Center
  1. ; or created by upload.
  1. K IVMAR
  1. S IVMX=$$EN^IVMUCHK() I IVMX]"" S HLERR=IVMX K IVMX Q ; error found in MT data
  1. ;
  1. ADD ; add new annual means test file (408.31) stub
  1. ; input DGMTDT (.01) dt of test
  1. ; DFN (.02) Patient IEN
  1. ; DGMTYPT (.19) type of test (1-means test)
  1. ; output DGMTI annual means test IEN
  1. S DGMTDT=IVMMTDT,DGMTYPT=1
  1. D ADD^DGMTA
  1. ;
  1. ; change primary income test for year? code from 1 to 0 for
  1. ; IVM means test.
  1. S DA=DGMTI,DIE="^DGMT(408.31,",DR="2////0"
  1. D ^DIE K DA,DIE,DR
  1. ;
  1. D GETREL^DGMTU11(DFN,"VSC",DGLY,IVMMTIEN)
  1. ;
  1. ; add dependent(s) to income person file (408.13)
  1. ;
  1. ; add spouse if not in 408.13
  1. S IVMSPCHV="S" ; spouse/child/vet indicator
  1. S IVMDA1=IVMDAP+3 D GET ; spouse ZDP segment
  1. D INPIEN^IVMUM2
  1. Q:$D(IVMFERR)
  1. ;
  1. I IVMFLG5 G ADDCHILD ; entry not added - goto add children
  1. ;
  1. ; add entry to patient relation file (408.12)
  1. D EN^IVMUM3
  1. Q:$D(IVMFERR)
  1. ;
  1. ADDS21 ; add spouse entry to individual annual income file (408.21)
  1. S IVMDA1=IVMDAP+4 D GET ; spouse ZIC segment
  1. D EN^IVMUM4
  1. Q:$D(IVMFERR)
  1. ;
  1. ; add spouse entry to income relation file (408.22)
  1. S IVMDA1=IVMDAP+5 D GET ; spouse ZIR segment
  1. D EN^IVMUM5
  1. Q:$D(IVMFERR)
  1. ;
  1. ADDCHILD ; add children if not in 408.13
  1. S IVMSPCHV="C" ; spouse/child/vet indicator
  1. I 'IVMFLGC G ADDV21 ; no dependent children
  1. S IVMCTR2=5
  1. F IVMCTR3=1:1:IVMFLGC D Q:$D(IVMFERR)
  1. .S IVMCTR2=IVMCTR2+1
  1. .S IVMDA1=IVMDAP+IVMCTR2 D GET ; child ZDP segment
  1. .D INPIEN^IVMUM2
  1. .Q:$D(IVMFERR)
  1. .;
  1. .; add child entry to patient relation file (408.12)
  1. .D EN^IVMUM3
  1. .Q:$D(IVMFERR)
  1. .;
  1. ADDC21 .; add child entry to individual annual income file (408.21)
  1. .S IVMCTR2=IVMCTR2+1
  1. .S IVMDA1=IVMDAP+IVMCTR2 D GET ; child ZIC segment
  1. .D EN^IVMUM4
  1. .Q:$D(IVMFERR)
  1. .;
  1. .; add entry to income relation file (408.22)
  1. .S IVMCTR2=IVMCTR2+1
  1. .S IVMDA1=IVMDAP+IVMCTR2 D GET ; child ZIR segment
  1. .D EN^IVMUM5
  1. .Q:$D(IVMFERR)
  1. .Q
  1. Q:$D(IVMFERR)
  1. ;
  1. ADDV21 ; add vet entry to individual annual income file (408.21)
  1. ; get vet patient relation ien
  1. S DGPRI=+$G(DGREL("V"))
  1. S IVMDA1=IVMDAP+1 D GET ; vet ZIC segment
  1. S IVMSPCHV="V" ; spouse/child/vet indicator
  1. D EN^IVMUM4
  1. Q:$D(IVMFERR)
  1. S DGVINI=DGINI ; vet individual annual income ien
  1. ;
  1. ; add vet entry to income relation file (408.22)
  1. S IVMDA1=IVMDAP+2 D GET ; vet ZIR segment
  1. D EN^IVMUM5
  1. Q:$D(IVMFERR)
  1. S DGVIRI=DGIRI ; vet income relation ien
  1. ;
  1. COMPLETE ; complete means test
  1. ;
  1. D EN^IVMUM6
  1. ;
  1. ; cleanup
  1. K DGINI,DGIRI,DGLY,DGMTDT,DGMTYPT,DGPRI,DGREL,DGVINI,DGVIRI
  1. K IVMAR,IVMCEB,IVMCTR2,IVMCTR3,IVMDA1,IVMDAP,IVMFERR
  1. K IVMFLG2,IVMFLG5,IVMFLGC,IVMMTB,IVMMTDT,IVMMTIEN,IVMPRN
  1. K IVMRELN,IVMRELO,IVMSEG,IVMSPCHV,IVMX
  1. Q
  1. ;
  1. GET ; get HL7 segment from ^HL
  1. S IVMSEG=$P($G(^TMP($J,IVMRTN,IVMDA1,0)),"^",2,999)
  1. Q