IVMLDEM4 ;ALB/KCL,PJR,LBD - IVM DEMOGRAPHIC UPLOAD/DELETE FIELDS ; 3/27/12 4:05pm
;;2.0;INCOME VERIFICATION MATCH;**5,10,56,102,152**; 21-OCT-94;Build 4
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
;
UF ; - (action) select uploadable demographic fields for filing
;
; Input: IVMWHERE -- as where the action is coming from
;
; -- If action from UPLOADABLE list:
; array of uploadable fields as
; ^TMP("IVMUPLOAD",$J,"IDX",CTR,CTR)=dfn^da(2)^da(1)^da^ivm field value^pointer to file (#1)^dhcp field number^dhcp field name
;
;
; - generic seletor used within list manager action
N VALMY,IVMDOD S IVMDOD=0
D EN^VALM2($G(XQORNOD(0)))
Q:'$D(VALMY)
;
N IVMPKDOD D CHECKS,CHECKDOD
;
S IVMENT4=0 F S IVMENT4=$O(VALMY(IVMENT4)) Q:'IVMENT4 D
.;
.S IVMINDEX=$G(^TMP("IVMUPLOAD",$J,"IDX",IVMENT4,IVMENT4)) I IVMINDEX']"" Q
.;
.; - check to see if selection is an address field
.S IVMADDR=$$ADDR^IVMLDEM6(+IVMINDEX,$P(IVMINDEX,"^",2),$P(IVMINDEX,"^",3),$P(IVMINDEX,"^",4),IVMPPICK)
.;
.Q:IVMADDR
.;
.; - check to see if selection is a Date of Death field
.I IVMPKDOD S IVMDOD=$$DOD^IVMLDEMD(+IVMINDEX,$P(IVMINDEX,"^",2),$P(IVMINDEX,"^",3),$P(IVMINDEX,"^",4))
.;
.Q:IVMDOD
.;
.; - ask user if they are sure they want to update field
.D RUSURE^IVMLDEMU($P(IVMINDEX,"^",8),"update") I IVMOUT!'IVMSURE Q
.;
.W !,"Updating "_$P(IVMINDEX,"^",8)_" field... "
.;
.; - upload value received from IVM into DHCP field
.D UPLOAD^IVMLDEMU(DFN,$P(IVMINDEX,"^",6),$P(IVMINDEX,"^",7),$P(IVMINDEX,"^",5))
.;
.; - remove entry from file (#301.5)
.D DELENT^IVMLDEMU($P(IVMINDEX,"^",2),$P(IVMINDEX,"^",3),$P(IVMINDEX,"^",4)) W "completed."
.;
;
; - hold display before building list
D PAUSE^VALM1
;
; - init the list and re-display to the user
D INIT^IVMLDEM2
;
DEQ ; clean-up variables
D QACTION
Q
;
;
DF ; - (action) select uploadable/non-uploadable demographic fields for deletion
;
; Input: IVMWHERE -- as where the action is coming from
;
; -- If action from UPLOADABLE list:
; array of uploadable fields as
; ^TMP("IVMUPLOAD",$J,"IDX",CTR,CTR)=dfn^da(2)^da(1)^da^ivm field value^pointer to file (#1)^dhcp field number^dhcp field name
;
; OR
;
; -- If action from NON-UPLOADABLE list:
; array of non-uploadable fields as
; ^TMP("IVMNONUP",$J,"IDX",CTR,CTR)=dfn^da(2)^da(1)^da^ivm field value^pointer to file (#1)^dhcp field number^dhcp field name
;
;
; Output: None
;
; - generic seletor used within list manager action
N VALMY
D EN^VALM2($G(XQORNOD(0)))
Q:'$D(VALMY)
;
; - determine array depending on variable IVMWHERE
S IVMARRAY=$S(IVMWHERE="UP":"IVMUPLOAD",1:"IVMNONUP")
;
N IVMPKDOD D CHECKS,CHECKDOD
;
S IVMENT4=0 F S IVMENT4=$O(VALMY(IVMENT4)) Q:'IVMENT4 D
.;
.I IVMWHERE="NON" D DF^IVMLDEM8 Q ; non-uploadable fields
.;
.; - get selected entry for uploadable fields
.S IVMINDEX=$G(^TMP(IVMARRAY,$J,"IDX",IVMENT4,IVMENT4)) Q:IVMINDEX']""
.;
.; - check to see if selection is an address field
.S IVMADDR=$$ADDR^IVMLDEM7(+IVMINDEX,$P(IVMINDEX,"^",2),$P(IVMINDEX,"^",3),$P(IVMINDEX,"^",4),IVMPPICK)
.;
.Q:IVMADDR
.;
.; - ask user if they are sure they want to delete field
.D RUSURE^IVMLDEMU($P(IVMINDEX,"^",8),"delete") I IVMOUT!'IVMSURE Q
.;
.W !,"Deleting "_$P(IVMINDEX,"^",8)_" field from the list... "
.;
.;if Date of Death is Deleted, send bulletin
.I IVMPKDOD D BULLETIN S IVMPKDOD=0
.;- remove entry from file (#301.5)
.D DELENT^IVMLDEMU($P(IVMINDEX,"^",2),$P(IVMINDEX,"^",3),$P(IVMINDEX,"^",4)) W "completed."
;
; - hold display before re-building list
D PAUSE^VALM1
;
; - init the list and re-display to the user
D @$S(IVMWHERE="UP":"INIT^IVMLDEM2",1:"INIT^IVMLDEM3")
;
DFQ ; clean-up variables
D QACTION
Q
;
;
CHECKS ; check if residence phone number selected
; check if another address field selected
; IVMPPICK=0 phone or an address field not selected
; 1 address field(s) selected
; 2 phone selected
; 3 both address field(s) and phone selected
;
N IVMPPIC1,IVMPPIC2
S (IVMPPICK,IVMPPIC2)=0
Q:IVMWHERE'="UP"
S IVMENT4=0 F S IVMENT4=$O(VALMY(IVMENT4)) Q:'IVMENT4 D
.I $G(^TMP("IVMUPLOAD",$J,"IDX",IVMENT4,IVMENT4))["PHONE NUMBER [RESIDENCE]" S IVMPPICK=2 Q
.I $G(^TMP("IVMUPLOAD",$J,"IDX",IVMENT4,IVMENT4))["RESIDENCE NUMBER CHANGE" S IVMPPICK=2 Q
.S IVMINDEX=$G(^TMP("IVMUPLOAD",$J,"IDX",IVMENT4,IVMENT4)) I IVMINDEX']"" Q
.S IVMPPIC1=+$G(^IVM(301.5,+$P(IVMINDEX,"^",2),"IN",+$P(IVMINDEX,"^",3),"DEM",+$P(IVMINDEX,"^",4),0)) Q:'IVMPPIC1
.S:$D(^IVM(301.92,"AD",+IVMPPIC1)) IVMPPIC2=1
.Q
S IVMPPICK=IVMPPICK+IVMPPIC2
Q
;
CHECKDOD ; check if date of death was selected
; IVMPKDOD=0 date of death not selected
; 1 date of death selected
;
N IVMPPIC1,IVMPPIC2,CKST
S (IVMPKDOD,IVMPPIC2)=0
Q:IVMWHERE'="UP"
S IVMENT4=0 F S IVMENT4=$O(VALMY(IVMENT4)) Q:'IVMENT4 D
.S CKST=$G(^TMP("IVMUPLOAD",$J,"IDX",IVMENT4,IVMENT4))
.I CKST["DATE OF DEATH"!(CKST["SOURCE OF NOTIFICATION")!(CKST["DATE OF DEATH LAST UPDATED") S IVMPKDOD=1 Q
Q
BULLETIN ; Non-Acceptance of Date of Death Data Bulletin
N DGBULL,DGLINE,DGMGRP,DGNAME,DIFROM,VA,VAERR,XMTEXT,XMSUB,XMDUZ
S DGMGRP=$O(^XMB(3.8,"B","DGEN ELIGIBILITY ALERT",""))
Q:'DGMGRP
D XMY^DGMTUTL(DGMGRP,0,1)
S DGNAME=$P($G(^DPT(DFN,0)),"^"),DGSSN=$P($G(^DPT(DFN,0)),"^",9)
S XMTEXT="DGBULL("
S XMSUB="NON-ACCEPTANCE OF DATE OF DEATH DATA"
S DGLINE=0
D LINE^DGEN("Patient: "_DGNAME,.DGLINE)
D LINE^DGEN("SSN: "_DGSSN,.DGLINE)
D LINE^DGEN("",.DGLINE)
D LINE^DGEN("This Veteran's Enrollment Record contains a Date of Death,",.DGLINE)
D LINE^DGEN("however, you did not upload this information into VistA.",.DGLINE)
D LINE^DGEN("Contact the HEC by phone or by fax with the reason for",.DGLINE)
D LINE^DGEN("non-acceptance. The HEC will delete erroneous Date of Death",.DGLINE)
D LINE^DGEN("information and update the veteran's enrollment record.",.DGLINE)
D ^XMD
Q
QACTION ; - kill variables used from all protocols
S VALMBCK="R"
K IVMADDR,IVMARRAY,IVMENT4,IVMINDEX,IVMOUT,IVMPPICK,IVMSURE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMLDEM4 6452 printed Sep 23, 2025@19:37:06 Page 2
IVMLDEM4 ;ALB/KCL,PJR,LBD - IVM DEMOGRAPHIC UPLOAD/DELETE FIELDS ; 3/27/12 4:05pm
+1 ;;2.0;INCOME VERIFICATION MATCH;**5,10,56,102,152**; 21-OCT-94;Build 4
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ;
UF ; - (action) select uploadable demographic fields for filing
+1 ;
+2 ; Input: IVMWHERE -- as where the action is coming from
+3 ;
+4 ; -- If action from UPLOADABLE list:
+5 ; array of uploadable fields as
+6 ; ^TMP("IVMUPLOAD",$J,"IDX",CTR,CTR)=dfn^da(2)^da(1)^da^ivm field value^pointer to file (#1)^dhcp field number^dhcp field name
+7 ;
+8 ;
+9 ; - generic seletor used within list manager action
+10 NEW VALMY,IVMDOD
SET IVMDOD=0
+11 DO EN^VALM2($GET(XQORNOD(0)))
+12 if '$DATA(VALMY)
QUIT
+13 ;
+14 NEW IVMPKDOD
DO CHECKS
DO CHECKDOD
+15 ;
+16 SET IVMENT4=0
FOR
SET IVMENT4=$ORDER(VALMY(IVMENT4))
if 'IVMENT4
QUIT
Begin DoDot:1
+17 ;
+18 SET IVMINDEX=$GET(^TMP("IVMUPLOAD",$JOB,"IDX",IVMENT4,IVMENT4))
IF IVMINDEX']""
QUIT
+19 ;
+20 ; - check to see if selection is an address field
+21 SET IVMADDR=$$ADDR^IVMLDEM6(+IVMINDEX,$PIECE(IVMINDEX,"^",2),$PIECE(IVMINDEX,"^",3),$PIECE(IVMINDEX,"^",4),IVMPPICK)
+22 ;
+23 if IVMADDR
QUIT
+24 ;
+25 ; - check to see if selection is a Date of Death field
+26 IF IVMPKDOD
SET IVMDOD=$$DOD^IVMLDEMD(+IVMINDEX,$PIECE(IVMINDEX,"^",2),$PIECE(IVMINDEX,"^",3),$PIECE(IVMINDEX,"^",4))
+27 ;
+28 if IVMDOD
QUIT
+29 ;
+30 ; - ask user if they are sure they want to update field
+31 DO RUSURE^IVMLDEMU($PIECE(IVMINDEX,"^",8),"update")
IF IVMOUT!'IVMSURE
QUIT
+32 ;
+33 WRITE !,"Updating "_$PIECE(IVMINDEX,"^",8)_" field... "
+34 ;
+35 ; - upload value received from IVM into DHCP field
+36 DO UPLOAD^IVMLDEMU(DFN,$PIECE(IVMINDEX,"^",6),$PIECE(IVMINDEX,"^",7),$PIECE(IVMINDEX,"^",5))
+37 ;
+38 ; - remove entry from file (#301.5)
+39 DO DELENT^IVMLDEMU($PIECE(IVMINDEX,"^",2),$PIECE(IVMINDEX,"^",3),$PIECE(IVMINDEX,"^",4))
WRITE "completed."
+40 ;
End DoDot:1
+41 ;
+42 ; - hold display before building list
+43 DO PAUSE^VALM1
+44 ;
+45 ; - init the list and re-display to the user
+46 DO INIT^IVMLDEM2
+47 ;
DEQ ; clean-up variables
+1 DO QACTION
+2 QUIT
+3 ;
+4 ;
DF ; - (action) select uploadable/non-uploadable demographic fields for deletion
+1 ;
+2 ; Input: IVMWHERE -- as where the action is coming from
+3 ;
+4 ; -- If action from UPLOADABLE list:
+5 ; array of uploadable fields as
+6 ; ^TMP("IVMUPLOAD",$J,"IDX",CTR,CTR)=dfn^da(2)^da(1)^da^ivm field value^pointer to file (#1)^dhcp field number^dhcp field name
+7 ;
+8 ; OR
+9 ;
+10 ; -- If action from NON-UPLOADABLE list:
+11 ; array of non-uploadable fields as
+12 ; ^TMP("IVMNONUP",$J,"IDX",CTR,CTR)=dfn^da(2)^da(1)^da^ivm field value^pointer to file (#1)^dhcp field number^dhcp field name
+13 ;
+14 ;
+15 ; Output: None
+16 ;
+17 ; - generic seletor used within list manager action
+18 NEW VALMY
+19 DO EN^VALM2($GET(XQORNOD(0)))
+20 if '$DATA(VALMY)
QUIT
+21 ;
+22 ; - determine array depending on variable IVMWHERE
+23 SET IVMARRAY=$SELECT(IVMWHERE="UP":"IVMUPLOAD",1:"IVMNONUP")
+24 ;
+25 NEW IVMPKDOD
DO CHECKS
DO CHECKDOD
+26 ;
+27 SET IVMENT4=0
FOR
SET IVMENT4=$ORDER(VALMY(IVMENT4))
if 'IVMENT4
QUIT
Begin DoDot:1
+28 ;
+29 ; non-uploadable fields
IF IVMWHERE="NON"
DO DF^IVMLDEM8
QUIT
+30 ;
+31 ; - get selected entry for uploadable fields
+32 SET IVMINDEX=$GET(^TMP(IVMARRAY,$JOB,"IDX",IVMENT4,IVMENT4))
if IVMINDEX']""
QUIT
+33 ;
+34 ; - check to see if selection is an address field
+35 SET IVMADDR=$$ADDR^IVMLDEM7(+IVMINDEX,$PIECE(IVMINDEX,"^",2),$PIECE(IVMINDEX,"^",3),$PIECE(IVMINDEX,"^",4),IVMPPICK)
+36 ;
+37 if IVMADDR
QUIT
+38 ;
+39 ; - ask user if they are sure they want to delete field
+40 DO RUSURE^IVMLDEMU($PIECE(IVMINDEX,"^",8),"delete")
IF IVMOUT!'IVMSURE
QUIT
+41 ;
+42 WRITE !,"Deleting "_$PIECE(IVMINDEX,"^",8)_" field from the list... "
+43 ;
+44 ;if Date of Death is Deleted, send bulletin
+45 IF IVMPKDOD
DO BULLETIN
SET IVMPKDOD=0
+46 ;- remove entry from file (#301.5)
+47 DO DELENT^IVMLDEMU($PIECE(IVMINDEX,"^",2),$PIECE(IVMINDEX,"^",3),$PIECE(IVMINDEX,"^",4))
WRITE "completed."
End DoDot:1
+48 ;
+49 ; - hold display before re-building list
+50 DO PAUSE^VALM1
+51 ;
+52 ; - init the list and re-display to the user
+53 DO @$SELECT(IVMWHERE="UP":"INIT^IVMLDEM2",1:"INIT^IVMLDEM3")
+54 ;
DFQ ; clean-up variables
+1 DO QACTION
+2 QUIT
+3 ;
+4 ;
CHECKS ; check if residence phone number selected
+1 ; check if another address field selected
+2 ; IVMPPICK=0 phone or an address field not selected
+3 ; 1 address field(s) selected
+4 ; 2 phone selected
+5 ; 3 both address field(s) and phone selected
+6 ;
+7 NEW IVMPPIC1,IVMPPIC2
+8 SET (IVMPPICK,IVMPPIC2)=0
+9 if IVMWHERE'="UP"
QUIT
+10 SET IVMENT4=0
FOR
SET IVMENT4=$ORDER(VALMY(IVMENT4))
if 'IVMENT4
QUIT
Begin DoDot:1
+11 IF $GET(^TMP("IVMUPLOAD",$JOB,"IDX",IVMENT4,IVMENT4))["PHONE NUMBER [RESIDENCE]"
SET IVMPPICK=2
QUIT
+12 IF $GET(^TMP("IVMUPLOAD",$JOB,"IDX",IVMENT4,IVMENT4))["RESIDENCE NUMBER CHANGE"
SET IVMPPICK=2
QUIT
+13 SET IVMINDEX=$GET(^TMP("IVMUPLOAD",$JOB,"IDX",IVMENT4,IVMENT4))
IF IVMINDEX']""
QUIT
+14 SET IVMPPIC1=+$GET(^IVM(301.5,+$PIECE(IVMINDEX,"^",2),"IN",+$PIECE(IVMINDEX,"^",3),"DEM",+$PIECE(IVMINDEX,"^",4),0))
if 'IVMPPIC1
QUIT
+15 if $DATA(^IVM(301.92,"AD",+IVMPPIC1))
SET IVMPPIC2=1
+16 QUIT
End DoDot:1
+17 SET IVMPPICK=IVMPPICK+IVMPPIC2
+18 QUIT
+19 ;
CHECKDOD ; check if date of death was selected
+1 ; IVMPKDOD=0 date of death not selected
+2 ; 1 date of death selected
+3 ;
+4 NEW IVMPPIC1,IVMPPIC2,CKST
+5 SET (IVMPKDOD,IVMPPIC2)=0
+6 if IVMWHERE'="UP"
QUIT
+7 SET IVMENT4=0
FOR
SET IVMENT4=$ORDER(VALMY(IVMENT4))
if 'IVMENT4
QUIT
Begin DoDot:1
+8 SET CKST=$GET(^TMP("IVMUPLOAD",$JOB,"IDX",IVMENT4,IVMENT4))
+9 IF CKST["DATE OF DEATH"!(CKST["SOURCE OF NOTIFICATION")!(CKST["DATE OF DEATH LAST UPDATED")
SET IVMPKDOD=1
QUIT
End DoDot:1
+10 QUIT
BULLETIN ; Non-Acceptance of Date of Death Data Bulletin
+1 NEW DGBULL,DGLINE,DGMGRP,DGNAME,DIFROM,VA,VAERR,XMTEXT,XMSUB,XMDUZ
+2 SET DGMGRP=$ORDER(^XMB(3.8,"B","DGEN ELIGIBILITY ALERT",""))
+3 if 'DGMGRP
QUIT
+4 DO XMY^DGMTUTL(DGMGRP,0,1)
+5 SET DGNAME=$PIECE($GET(^DPT(DFN,0)),"^")
SET DGSSN=$PIECE($GET(^DPT(DFN,0)),"^",9)
+6 SET XMTEXT="DGBULL("
+7 SET XMSUB="NON-ACCEPTANCE OF DATE OF DEATH DATA"
+8 SET DGLINE=0
+9 DO LINE^DGEN("Patient: "_DGNAME,.DGLINE)
+10 DO LINE^DGEN("SSN: "_DGSSN,.DGLINE)
+11 DO LINE^DGEN("",.DGLINE)
+12 DO LINE^DGEN("This Veteran's Enrollment Record contains a Date of Death,",.DGLINE)
+13 DO LINE^DGEN("however, you did not upload this information into VistA.",.DGLINE)
+14 DO LINE^DGEN("Contact the HEC by phone or by fax with the reason for",.DGLINE)
+15 DO LINE^DGEN("non-acceptance. The HEC will delete erroneous Date of Death",.DGLINE)
+16 DO LINE^DGEN("information and update the veteran's enrollment record.",.DGLINE)
+17 DO ^XMD
+18 QUIT
QACTION ; - kill variables used from all protocols
+1 SET VALMBCK="R"
+2 KILL IVMADDR,IVMARRAY,IVMENT4,IVMINDEX,IVMOUT,IVMPPICK,IVMSURE
+3 QUIT
