Routine: IVMLDEM4

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

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

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

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

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

QACTION ; - kill variables used from all protocols

 S VALMBCK="R"

 K IVMADDR,IVMARRAY,IVMENT4,IVMINDEX,IVMOUT,IVMPPICK,IVMSURE

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMLDEM4   6452     printed  Mar 13, 2025@21:05:48                                                                                                                                                                                                    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

IVMLDEM4.m