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

IVMCM5.m

Go to the documentation of this file.
  1. IVMCM5 ;ALB/SEK,BRM,CKN,PWC - ADD NEW DCD INCOME RELATION FILE ENTRIES ;2/8/06 2:01pm
  1. ;;2.0;INCOME VERIFICATION MATCH;**17,49,105,160**;21-OCT-94;Build 19
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. EN ; this routine will add entries to INCOME RELATION file (408.22).
  1. ; will inactivate dependents (spouse & children) who are not
  1. ; dependents of the test being uploaded, by adding an inactivate
  1. ; entry into the EFFECTIVE DATE sub-file (multiple-408.1275) of
  1. ; the PATIENT RELATION file (#408.12).
  1. ;
  1. ; exceptions to above:
  1. ; . income screening:
  1. ; . "mt" node not set to annual means test ien
  1. ; . no replaced test to change primary test for income year
  1. ; field to 0
  1. ;
  1. ;
  1. ; DFN Patient file IEN
  1. ; DGINI Individual Annual Income IEN
  1. ; DGIRI Income Relation IEN
  1. ; IVMSEG ZIR record for veteran or spouse or dependent
  1. ; IVM0 408.22 0 node pieces 5-7
  1. ; IVM01 0 node pieces 9-12
  1. ; IVM02 0 node piece 6
  1. ; IVM03 0 node piece 18
  1. ;
  1. N IVM0,IVM01,IVM02,IVM03,IVM04
  1. S DGIRI=$$ADDIR^DGMTU2(DFN,DGINI)
  1. ;
  1. ; if can't create stub notify site & IVM Center
  1. I DGIRI'>0 D Q
  1. .S (IVMTEXT(6))="Can't create stub for file 408.22"
  1. .D PROB^IVMCMC(IVMTEXT(6))
  1. .D ERRBULL^IVMPREC7,MAIL^IVMUFNC("DGMT MT/CT UPLOAD ALERTS")
  1. .S IVMFERR=""
  1. ;
  1. ; set "mt" node to annual means test ien
  1. I "^1^2^4^"[("^"_IVMTYPE_"^") D MT^DGMTSCU3(DGIRI,DGMTI)
  1. ;
  1. Q:IVMSPCHV="S"
  1. ;
  1. ; set number of dependent children (#.13) and dependent children(#.08)
  1. ; in income relation file (#408.22) based on active child dependents
  1. ; in patient relation file (#408.12).
  1. ; make DCD means test or copay test primary income test for year
  1. I IVMSPCHV="V" D Q:$D(IVMFERR)
  1. .;
  1. .; inactivate dependents who are not dependents of the test
  1. .; being uploaded.
  1. .K DGREL("V")
  1. .I $D(DGREL) D INACTIVE Q:$D(IVMFERR)
  1. .;
  1. .D RESET^DGMTU11(DFN,DGLY,$S($G(DGMTI):DGMTI,1:0))
  1. .I $P($G(^DGMT(408.22,DGIRI,0)),"^",8)="" D
  1. ..S DA=DGIRI,DR=".08////0;.13////@",DIE="^DGMT(408.22," D ^DIE
  1. ..K DA,DR,DIE
  1. .S IVM0=$P(IVMSEG,"^",2,4),IVM04=$P(IVMSEG,"^",15) ;Begin IVM*2.0*160 Added contrib to spouse for VET record
  1. I IVMSPCHV="C" S IVM01=$P(IVMSEG,"^",6,9),IVM02=$P(IVMSEG,"^",3),IVM03=$$CONVERT($P(IVMSEG,"^",14),"1/0")
  1. S DIK="^DGMT(408.22,"
  1. I IVMSPCHV="C" L +^DGMT(408.22,DGIRI):5 S $P(^DGMT(408.22,DGIRI,0),"^",9,12)=IVM01,$P(^(0),"^",6)=IVM02,$P(^(0),"^",18)=IVM03 S DA=DGIRI D IX1^DIK L -^DGMT(408.22,DGIRI)
  1. I IVMSPCHV="V" L +^DGMT(408.22,DGIRI):5 S $P(^DGMT(408.22,DGIRI,0),"^",5,7)=IVM0,$P(^(0),"^",20)=IVM04 S DA=DGIRI D IX1^DIK L -^DGMT(408.22,DGIRI)
  1. ;End IVM*2.0*160 changes
  1. K DA,DIK
  1. Q
  1. ;
  1. INACTIVE ; inactivate dependents not in DCD means test or copay test and
  1. ; kill corresponding dgrel
  1. N X,Y
  1. I $D(DGREL("S")) S DA(1)=+DGREL("S") D K DGREL("S")
  1. .D CHKINACT
  1. .Q:IVMFLG6!($D(IVMFERR))
  1. .; if spouse was active before income year, add record with date
  1. .; of 12/31 of year before income year with active code 0
  1. .S X=$E(DGLY,1,3)-1_1231
  1. .D INACT1
  1. Q:'$D(DGREL)!($D(IVMFERR))
  1. S IVMACTR=0
  1. F S IVMACTR=$O(DGREL("C",IVMACTR)) Q:'IVMACTR S DA(1)=+DGREL("C",IVMACTR) D K DGREL("C",IVMACTR)
  1. .D CHKINACT
  1. .Q:IVMFLG6!($D(IVMFERR))
  1. .; if child was active before income year, add record with date
  1. .; of 12/31 of year before income year with active code 0
  1. .S X=$E(DGLY,1,3)-1_1231
  1. .D INACT1
  1. ;
  1. K IVMACTR,IVMDGLY,IVMFLG6,IVMYEAR
  1. Q
  1. ;
  1. CHKINACT ; if dependent was made active during income year
  1. ; add record for same date (add .08 time) with active code 0
  1. ;
  1. S IVMFLG6=0
  1. S IVMDGLY="" F S IVMDGLY=$O(^DGPR(408.12,DA(1),"E","B",IVMDGLY)) Q:IVMDGLY']"" D Q:IVMFLG6!($D(IVMFERR))
  1. .Q:$E(IVMDGLY,1,3)'=$E(DGLY,1,3)
  1. .S IVMYEAR=0 F S IVMYEAR=$O(^DGPR(408.12,DA(1),"E","B",IVMDGLY,IVMYEAR)) Q:IVMYEAR']"" D Q:IVMFLG6!($D(IVMFERR))
  1. ..I $P($G(^DGPR(408.12,DA(1),"E",IVMYEAR,0)),"^",2) D
  1. ...S X=IVMDGLY_.08 D INACT1 S IVMFLG6=1
  1. ...Q
  1. Q
  1. ;
  1. INACT1 ; add inactivate entry to 408.1275
  1. ;
  1. K DINUM
  1. S (DIK,DIC)="^DGPR(408.12,DA(1),""E"",",DIC(0)="L",DLAYGO=408.1275 K DD,DO D FILE^DICN S DA=+Y K DLAYGO
  1. ;
  1. ; if can't create stub notify site & IVM Center
  1. I DA'>0 D Q
  1. .S (IVMTEXT(6))="Can't create stub for file 408.1275"
  1. .D PROB^IVMCMC(IVMTEXT(6))
  1. .D ERRBULL^IVMPREC7,MAIL^IVMUFNC("DGMT MT/CT UPLOAD ALERTS")
  1. .S IVMFERR=""
  1. L +^DGPR(408.12,+DGPRI):5 S $P(^DGPR(408.12,DA(1),"E",DA,0),"^",2,4)=0_"^"_1_$S(IVMTYPE=3:"",1:"^"_DGMTI) D IX1^DIK L -^DGPR(408.12,+DGPRI)
  1. K DA,DIC,DIK
  1. Q
  1. CONVERT(VAL,DATATYPE) ;Data Conversion
  1. ; Description: Converts the value found in the HL7 segment to DHCP format
  1. ;Input:
  1. ; VAL - value parsed from HL7 segment
  1. ; DATATYPE - indicates the type of conversion necessary
  1. ; "1/0" - "Y"->1,"N"->0
  1. ;Currently only one type needs to be converted but new data types can
  1. ;be added for other conversion
  1. I VAL="" Q VAL
  1. I VAL="""""" S VAL="@" Q VAL
  1. I ($G(DATATYPE)="1/0") D
  1. .I VAL="N" S VAL=0 Q
  1. .I VAL="Y" S VAL=1 Q
  1. .S VAL=""
  1. Q VAL