- 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 Feb 18, 2025@23:26:52 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