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

IVMUM7.m

Go to the documentation of this file.
  1. IVMUM7 ;ALB/SEK,RTK - DELETE IVM MEANS TEST ; 23 JUNE 00
  1. ;;2.0;INCOME VERIFICATION MATCH;**1,17,31**;21-OCT-94
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. EN ; this routine will process an IVM means test delete request
  1. ; from the IVM Center.
  1. ;
  1. ; delete IVM mean test records in the following files:
  1. ; 408.22
  1. ; 408.21
  1. ;
  1. ; 408.12 & 408.13 if IVM dependent
  1. ; or
  1. ; 408.1275 if IVM & VAMC dependent (new 408.1275 record was
  1. ; created for each IVM dependent by upload).
  1. ; change back the following fields to VAMC values
  1. ; from IVM values:
  1. ; 408.12 - relationship
  1. ; 408.13 - name, dob, ssn, sex
  1. ; or
  1. ; 408.1275 if VAMC dependent (new inactivated 408.1275 record
  1. ; was created by upload).
  1. ;
  1. ; 408.31
  1. ;
  1. ; the "PRIM" node for the VAMC MT will be changed to 1
  1. ;
  1. ; the event driver will be called twice
  1. ; DGMTACT="DUP"
  1. ; DGMTACT="DEL"
  1. ;
  1. ;
  1. ; Input IVMMTDT MT date
  1. ; IVMMTIEN primary MT IEN
  1. ;
  1. ; check primary test is IVM
  1. S IVMNO=$G(^DGMT(408.31,IVMMTIEN,0)) ; ivm mt 0th node
  1. S IVMSOT=$P($G(^DG(408.34,+$P(IVMNO,"^",23),0)),"^") ; source of test
  1. I IVMSOT'="IVM" D Q
  1. .S HLERR="IVM means test for income year "_($E(DGLY,1,3)+1700)_" not found"
  1. .D ACK^IVMPREC
  1. ;
  1. ; get VAMC mt
  1. S IVMVAMC=0 ; ivmvamc is vamc ien
  1. F S IVMVAMC=$O(^DGMT(408.31,"AD",1,DFN,IVMMTDT,IVMVAMC)) Q:'IVMVAMC D Q:$D(IVMVNO)
  1. .S IVMVNO=$G(^DGMT(408.31,+IVMVAMC,0)) ; vamc 0th node
  1. .S IVMSOT=$P($G(^DG(408.34,+$P(IVMVNO,"^",23),0)),"^") ; source of test
  1. .I IVMSOT'="VAMC",IVMSOT'="DCD",IVMSOT'="OTHER FACILITY" K IVMVNO Q
  1. I '$D(IVMVNO) D Q
  1. .S HLERR=IVMSOT_" means test for income year "_($E(DGLY,1,3)+1700)_" not found"
  1. .D ACK^IVMPREC
  1. ;
  1. ; get array dginc containing ien(s) of 408.21
  1. ; get array dginr containing ien(s) of 408.22
  1. D ALL^DGMTU21(DFN,"VSC",IVMMTDT,"IR",IVMMTIEN)
  1. ;
  1. ; delete 408.22
  1. ;
  1. S DA=$G(DGINR("V")) D
  1. .Q:'DA S DIK="^DGMT(408.22," D ^DIK
  1. S DA=$G(DGINR("S")) D
  1. .Q:'DA S DIK="^DGMT(408.22," D ^DIK
  1. S IVMN=0
  1. F S IVMN=$O(DGINR("C",IVMN)) Q:'IVMN S DA=$G(DGINR("C",IVMN)),DIK="^DGMT(408.22," D ^DIK
  1. ;
  1. ; delete 408.21
  1. ;
  1. S DA=$G(DGINC("V")) D
  1. .Q:'DA S DIK="^DGMT(408.21," D ^DIK
  1. S DA=$G(DGINC("S")) D
  1. .Q:'DA S DIK="^DGMT(408.21," D ^DIK
  1. S IVMN=0
  1. F S IVMN=$O(DGINC("C",IVMN)) Q:'IVMN S DA=$G(DGINC("C",IVMN)),DIK="^DGMT(408.21," D ^DIK
  1. ;
  1. ; logic for 408.12/408.1275 & 408.13
  1. ;
  1. D SETUPAR^IVMUM8
  1. ;
  1. ; no "AIVM" x-ref means
  1. ; no dependents
  1. ; or
  1. ; IVM v2.0 means test (no dependent difference)
  1. ; only 408.22, 408.21, and 408.31 records will be deleted
  1. ;
  1. S IVM12="" F S IVM12=$O(^DGPR(408.12,"AIVM",IVMMTIEN,IVM12)) Q:'IVM12 D Q:$D(IVMFERR)
  1. .I $G(^DGPR(408.12,+IVM12,0))']"" D Q
  1. ..S (IVMTEXT(6),HLERR)="Can't find 408.12 record "_IVM12
  1. ..D ERRBULL^IVMPREC7,MAIL^IVMUFNC()
  1. ..S IVMFERR=""
  1. ..D ACK^IVMPREC
  1. ..Q
  1. .;
  1. .I $P($G(^DGPR(408.12,+IVM12,"E",0)),"^",4)=1 D Q
  1. ..; only 1 multiple record (408.1275) indicates IVM dependent
  1. ..; delete 408.12 & 408.13 records for IVM dependent
  1. ..S IVM13=$P($P($G(^DGPR(408.12,+IVM12,0)),"^",3),";") I $G(^DGPR(408.13,+IVM13,0))']"" D Q
  1. ...S (IVMTEXT(6),HLERR)="Can't find 408.13 record "_IVM13
  1. ...D ERRBULL^IVMPREC7,MAIL^IVMUFNC()
  1. ...S IVMFERR=""
  1. ...D ACK^IVMPREC
  1. ...Q
  1. ..S DA=IVM12,DIK="^DGPR(408.12," D ^DIK K DA,DIK
  1. ..S DA=IVM13,DIK="^DGPR(408.13," D ^DIK K DA,DIK
  1. ..Q
  1. .;
  1. .; delete 408.1275 record for IVM dependent and
  1. .; change demo data in 408.12 & 408.13 back to VAMC values
  1. .; or
  1. .; delete 408.1275 record for inactivated VAMC dependent
  1. .S IVM121="",IVM121=$O(^DGPR(408.12,"AIVM",IVMMTIEN,+IVM12,IVM121))
  1. .I $G(^DGPR(408.12,+IVM12,"E",+IVM121,0))']"" D Q
  1. ..S (IVMTEXT(6),HLERR)="Can't find 408.1275 record "_IVM12_" "_IVM121
  1. ..D ERRBULL^IVMPREC7,MAIL^IVMUFNC()
  1. ..S IVMFERR=""
  1. ..D ACK^IVMPREC
  1. ..Q
  1. .S IVMVAMCA=$P(^(0),"^",2) ; dependent active?
  1. .S DA(1)=IVM12,DA=IVM121,DIK="^DGPR(408.12,"_DA(1)_",""E"","
  1. .D ^DIK K DA(1),DA,DIK
  1. .Q:'IVMVAMCA ; quit if inactivated VAMC dependent
  1. .S IVM13=+$P($P($G(^DGPR(408.12,+IVM12,0)),"^",3),";")
  1. .D EN^IVMUM8
  1. .Q
  1. ;
  1. Q:$D(IVMFERR)
  1. D EN1^IVMUM8
  1. Q