IVMCM5 ;ALB/SEK,BRM,CKN,PWC - ADD NEW DCD INCOME RELATION FILE ENTRIES ;2/8/06 2:01pm
;;2.0;INCOME VERIFICATION MATCH;**17,49,105,160**;21-OCT-94;Build 19
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
EN ; this routine will add entries to INCOME RELATION file (408.22).
; will inactivate dependents (spouse & children) who are not
; dependents of the test being uploaded, by adding an inactivate
; entry into the EFFECTIVE DATE sub-file (multiple-408.1275) of
; the PATIENT RELATION file (#408.12).
;
; exceptions to above:
; . income screening:
; . "mt" node not set to annual means test ien
; . no replaced test to change primary test for income year
; field to 0
;
;
; DFN Patient file IEN
; DGINI Individual Annual Income IEN
; DGIRI Income Relation IEN
; IVMSEG ZIR record for veteran or spouse or dependent
; IVM0 408.22 0 node pieces 5-7
; IVM01 0 node pieces 9-12
; IVM02 0 node piece 6
; IVM03 0 node piece 18
;
N IVM0,IVM01,IVM02,IVM03,IVM04
S DGIRI=$$ADDIR^DGMTU2(DFN,DGINI)
;
; if can't create stub notify site & IVM Center
I DGIRI'>0 D Q
.S (IVMTEXT(6))="Can't create stub for file 408.22"
.D PROB^IVMCMC(IVMTEXT(6))
.D ERRBULL^IVMPREC7,MAIL^IVMUFNC("DGMT MT/CT UPLOAD ALERTS")
.S IVMFERR=""
;
; set "mt" node to annual means test ien
I "^1^2^4^"[("^"_IVMTYPE_"^") D MT^DGMTSCU3(DGIRI,DGMTI)
;
Q:IVMSPCHV="S"
;
; set number of dependent children (#.13) and dependent children(#.08)
; in income relation file (#408.22) based on active child dependents
; in patient relation file (#408.12).
; make DCD means test or copay test primary income test for year
I IVMSPCHV="V" D Q:$D(IVMFERR)
.;
.; inactivate dependents who are not dependents of the test
.; being uploaded.
.K DGREL("V")
.I $D(DGREL) D INACTIVE Q:$D(IVMFERR)
.;
.D RESET^DGMTU11(DFN,DGLY,$S($G(DGMTI):DGMTI,1:0))
.I $P($G(^DGMT(408.22,DGIRI,0)),"^",8)="" D
..S DA=DGIRI,DR=".08////0;.13////@",DIE="^DGMT(408.22," D ^DIE
..K DA,DR,DIE
.S IVM0=$P(IVMSEG,"^",2,4),IVM04=$P(IVMSEG,"^",15) ;Begin IVM*2.0*160 Added contrib to spouse for VET record
I IVMSPCHV="C" S IVM01=$P(IVMSEG,"^",6,9),IVM02=$P(IVMSEG,"^",3),IVM03=$$CONVERT($P(IVMSEG,"^",14),"1/0")
S DIK="^DGMT(408.22,"
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)
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)
;End IVM*2.0*160 changes
K DA,DIK
Q
;
INACTIVE ; inactivate dependents not in DCD means test or copay test and
; kill corresponding dgrel
N X,Y
I $D(DGREL("S")) S DA(1)=+DGREL("S") D K DGREL("S")
.D CHKINACT
.Q:IVMFLG6!($D(IVMFERR))
.; if spouse was active before income year, add record with date
.; of 12/31 of year before income year with active code 0
.S X=$E(DGLY,1,3)-1_1231
.D INACT1
Q:'$D(DGREL)!($D(IVMFERR))
S IVMACTR=0
F S IVMACTR=$O(DGREL("C",IVMACTR)) Q:'IVMACTR S DA(1)=+DGREL("C",IVMACTR) D K DGREL("C",IVMACTR)
.D CHKINACT
.Q:IVMFLG6!($D(IVMFERR))
.; if child was active before income year, add record with date
.; of 12/31 of year before income year with active code 0
.S X=$E(DGLY,1,3)-1_1231
.D INACT1
;
K IVMACTR,IVMDGLY,IVMFLG6,IVMYEAR
Q
;
CHKINACT ; if dependent was made active during income year
; add record for same date (add .08 time) with active code 0
;
S IVMFLG6=0
S IVMDGLY="" F S IVMDGLY=$O(^DGPR(408.12,DA(1),"E","B",IVMDGLY)) Q:IVMDGLY']"" D Q:IVMFLG6!($D(IVMFERR))
.Q:$E(IVMDGLY,1,3)'=$E(DGLY,1,3)
.S IVMYEAR=0 F S IVMYEAR=$O(^DGPR(408.12,DA(1),"E","B",IVMDGLY,IVMYEAR)) Q:IVMYEAR']"" D Q:IVMFLG6!($D(IVMFERR))
..I $P($G(^DGPR(408.12,DA(1),"E",IVMYEAR,0)),"^",2) D
...S X=IVMDGLY_.08 D INACT1 S IVMFLG6=1
...Q
Q
;
INACT1 ; add inactivate entry to 408.1275
;
K DINUM
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
;
; if can't create stub notify site & IVM Center
I DA'>0 D Q
.S (IVMTEXT(6))="Can't create stub for file 408.1275"
.D PROB^IVMCMC(IVMTEXT(6))
.D ERRBULL^IVMPREC7,MAIL^IVMUFNC("DGMT MT/CT UPLOAD ALERTS")
.S IVMFERR=""
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)
K DA,DIC,DIK
Q
CONVERT(VAL,DATATYPE) ;Data Conversion
; Description: Converts the value found in the HL7 segment to DHCP format
;Input:
; VAL - value parsed from HL7 segment
; DATATYPE - indicates the type of conversion necessary
; "1/0" - "Y"->1,"N"->0
;Currently only one type needs to be converted but new data types can
;be added for other conversion
I VAL="" Q VAL
I VAL="""""" S VAL="@" Q VAL
I ($G(DATATYPE)="1/0") D
.I VAL="N" S VAL=0 Q
.I VAL="Y" S VAL=1 Q
.S VAL=""
Q VAL
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMCM5 5072 printed Apr 09, 2024@21:03:37 Page 2
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
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
EN ; this routine will add entries to INCOME RELATION file (408.22).
+1 ; will inactivate dependents (spouse & children) who are not
+2 ; dependents of the test being uploaded, by adding an inactivate
+3 ; entry into the EFFECTIVE DATE sub-file (multiple-408.1275) of
+4 ; the PATIENT RELATION file (#408.12).
+5 ;
+6 ; exceptions to above:
+7 ; . income screening:
+8 ; . "mt" node not set to annual means test ien
+9 ; . no replaced test to change primary test for income year
+10 ; field to 0
+11 ;
+12 ;
+13 ; DFN Patient file IEN
+14 ; DGINI Individual Annual Income IEN
+15 ; DGIRI Income Relation IEN
+16 ; IVMSEG ZIR record for veteran or spouse or dependent
+17 ; IVM0 408.22 0 node pieces 5-7
+18 ; IVM01 0 node pieces 9-12
+19 ; IVM02 0 node piece 6
+20 ; IVM03 0 node piece 18
+21 ;
+22 NEW IVM0,IVM01,IVM02,IVM03,IVM04
+23 SET DGIRI=$$ADDIR^DGMTU2(DFN,DGINI)
+24 ;
+25 ; if can't create stub notify site & IVM Center
+26 IF DGIRI'>0
Begin DoDot:1
+27 SET (IVMTEXT(6))="Can't create stub for file 408.22"
+28 DO PROB^IVMCMC(IVMTEXT(6))
+29 DO ERRBULL^IVMPREC7
DO MAIL^IVMUFNC("DGMT MT/CT UPLOAD ALERTS")
+30 SET IVMFERR=""
End DoDot:1
QUIT
+31 ;
+32 ; set "mt" node to annual means test ien
+33 IF "^1^2^4^"[("^"_IVMTYPE_"^")
DO MT^DGMTSCU3(DGIRI,DGMTI)
+34 ;
+35 if IVMSPCHV="S"
QUIT
+36 ;
+37 ; set number of dependent children (#.13) and dependent children(#.08)
+38 ; in income relation file (#408.22) based on active child dependents
+39 ; in patient relation file (#408.12).
+40 ; make DCD means test or copay test primary income test for year
+41 IF IVMSPCHV="V"
Begin DoDot:1
+42 ;
+43 ; inactivate dependents who are not dependents of the test
+44 ; being uploaded.
+45 KILL DGREL("V")
+46 IF $DATA(DGREL)
DO INACTIVE
if $DATA(IVMFERR)
QUIT
+47 ;
+48 DO RESET^DGMTU11(DFN,DGLY,$SELECT($GET(DGMTI):DGMTI,1:0))
+49 IF $PIECE($GET(^DGMT(408.22,DGIRI,0)),"^",8)=""
Begin DoDot:2
+50 SET DA=DGIRI
SET DR=".08////0;.13////@"
SET DIE="^DGMT(408.22,"
DO ^DIE
+51 KILL DA,DR,DIE
End DoDot:2
+52 ;Begin IVM*2.0*160 Added contrib to spouse for VET record
SET IVM0=$PIECE(IVMSEG,"^",2,4)
SET IVM04=$PIECE(IVMSEG,"^",15)
End DoDot:1
if $DATA(IVMFERR)
QUIT
+53 IF IVMSPCHV="C"
SET IVM01=$PIECE(IVMSEG,"^",6,9)
SET IVM02=$PIECE(IVMSEG,"^",3)
SET IVM03=$$CONVERT($PIECE(IVMSEG,"^",14),"1/0")
+54 SET DIK="^DGMT(408.22,"
+55 IF IVMSPCHV="C"
LOCK +^DGMT(408.22,DGIRI):5
SET $PIECE(^DGMT(408.22,DGIRI,0),"^",9,12)=IVM01
SET $PIECE(^(0),"^",6)=IVM02
SET $PIECE(^(0),"^",18)=IVM03
SET DA=DGIRI
DO IX1^DIK
LOCK -^DGMT(408.22,DGIRI)
+56 IF IVMSPCHV="V"
LOCK +^DGMT(408.22,DGIRI):5
SET $PIECE(^DGMT(408.22,DGIRI,0),"^",5,7)=IVM0
SET $PIECE(^(0),"^",20)=IVM04
SET DA=DGIRI
DO IX1^DIK
LOCK -^DGMT(408.22,DGIRI)
+57 ;End IVM*2.0*160 changes
+58 KILL DA,DIK
+59 QUIT
+60 ;
INACTIVE ; inactivate dependents not in DCD means test or copay test and
+1 ; kill corresponding dgrel
+2 NEW X,Y
+3 IF $DATA(DGREL("S"))
SET DA(1)=+DGREL("S")
Begin DoDot:1
+4 DO CHKINACT
+5 if IVMFLG6!($DATA(IVMFERR))
QUIT
+6 ; if spouse was active before income year, add record with date
+7 ; of 12/31 of year before income year with active code 0
+8 SET X=$EXTRACT(DGLY,1,3)-1_1231
+9 DO INACT1
End DoDot:1
KILL DGREL("S")
+10 if '$DATA(DGREL)!($DATA(IVMFERR))
QUIT
+11 SET IVMACTR=0
+12 FOR
SET IVMACTR=$ORDER(DGREL("C",IVMACTR))
if 'IVMACTR
QUIT
SET DA(1)=+DGREL("C",IVMACTR)
Begin DoDot:1
+13 DO CHKINACT
+14 if IVMFLG6!($DATA(IVMFERR))
QUIT
+15 ; if child was active before income year, add record with date
+16 ; of 12/31 of year before income year with active code 0
+17 SET X=$EXTRACT(DGLY,1,3)-1_1231
+18 DO INACT1
End DoDot:1
KILL DGREL("C",IVMACTR)
+19 ;
+20 KILL IVMACTR,IVMDGLY,IVMFLG6,IVMYEAR
+21 QUIT
+22 ;
CHKINACT ; if dependent was made active during income year
+1 ; add record for same date (add .08 time) with active code 0
+2 ;
+3 SET IVMFLG6=0
+4 SET IVMDGLY=""
FOR
SET IVMDGLY=$ORDER(^DGPR(408.12,DA(1),"E","B",IVMDGLY))
if IVMDGLY']""
QUIT
Begin DoDot:1
+5 if $EXTRACT(IVMDGLY,1,3)'=$EXTRACT(DGLY,1,3)
QUIT
+6 SET IVMYEAR=0
FOR
SET IVMYEAR=$ORDER(^DGPR(408.12,DA(1),"E","B",IVMDGLY,IVMYEAR))
if IVMYEAR']""
QUIT
Begin DoDot:2
+7 IF $PIECE($GET(^DGPR(408.12,DA(1),"E",IVMYEAR,0)),"^",2)
Begin DoDot:3
+8 SET X=IVMDGLY_.08
DO INACT1
SET IVMFLG6=1
+9 QUIT
End DoDot:3
End DoDot:2
if IVMFLG6!($DATA(IVMFERR))
QUIT
End DoDot:1
if IVMFLG6!($DATA(IVMFERR))
QUIT
+10 QUIT
+11 ;
INACT1 ; add inactivate entry to 408.1275
+1 ;
+2 KILL DINUM
+3 SET (DIK,DIC)="^DGPR(408.12,DA(1),""E"","
SET DIC(0)="L"
SET DLAYGO=408.1275
KILL DD,DO
DO FILE^DICN
SET DA=+Y
KILL DLAYGO
+4 ;
+5 ; if can't create stub notify site & IVM Center
+6 IF DA'>0
Begin DoDot:1
+7 SET (IVMTEXT(6))="Can't create stub for file 408.1275"
+8 DO PROB^IVMCMC(IVMTEXT(6))
+9 DO ERRBULL^IVMPREC7
DO MAIL^IVMUFNC("DGMT MT/CT UPLOAD ALERTS")
+10 SET IVMFERR=""
End DoDot:1
QUIT
+11 LOCK +^DGPR(408.12,+DGPRI):5
SET $PIECE(^DGPR(408.12,DA(1),"E",DA,0),"^",2,4)=0_"^"_1_$SELECT(IVMTYPE=3:"",1:"^"_DGMTI)
DO IX1^DIK
LOCK -^DGPR(408.12,+DGPRI)
+12 KILL DA,DIC,DIK
+13 QUIT
CONVERT(VAL,DATATYPE) ;Data Conversion
+1 ; Description: Converts the value found in the HL7 segment to DHCP format
+2 ;Input:
+3 ; VAL - value parsed from HL7 segment
+4 ; DATATYPE - indicates the type of conversion necessary
+5 ; "1/0" - "Y"->1,"N"->0
+6 ;Currently only one type needs to be converted but new data types can
+7 ;be added for other conversion
+8 IF VAL=""
QUIT VAL
+9 IF VAL=""""""
SET VAL="@"
QUIT VAL
+10 IF ($GET(DATATYPE)="1/0")
Begin DoDot:1
+11 IF VAL="N"
SET VAL=0
QUIT
+12 IF VAL="Y"
SET VAL=1
QUIT
+13 SET VAL=""
End DoDot:1
+14 QUIT VAL
