Routine: IVMLDEMB

IVMLDEMB ;ALB/PHH - IVM DEMOGRAPHIC UPLOAD FILE DATE OF DEATH FIELDS ; 04/17/2009

 ;;2.0;INCOME VERIFICATION MATCH;**131**; 21-OCT-94;Build 2

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

CKINPAT(DFN) ; Check if InPatient

 ; Function returns 1 if yes, 0 if no

 N RETVAL

 S RETVAL=0

 S RETVAL=$$CURINPAT^DGENPTA(DFN)

 Q RETVAL

AUTOREJ ; Auto Reject a DOD

 ; - loop through DOD fields

 F DODFIELD="ZPD09","ZPD31","ZPD32" D

 .S IVMI=$O(^IVM(301.92,"C",DODFIELD,"")) I IVMI="" Q

 .S IVMJ=$O(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM","B",IVMI,"")) Q:IVMJ']""  D

..;

 ..; - check for data node in (#301.511) sub-file

 ..S IVMNODE=$G(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM",IVMJ,0)) Q:'(+IVMNODE)

..;

 ..I DODFIELD="ZPD09" D

 ...S DODREJDT=$P(IVMNODE,"^",2)

..;

 ..; - remove entry from (#301.511) sub-file

 ..D DELENT^IVMLDEMU(IVMDA2,IVMDA1,IVMJ)

 D CLEAN^IVMLDEMD(IVMDA2)

SNDBULL ; Send MailMan Bulletin to HEC to remove DOD

 N DGBULL,DGLINE,DGMGRP,DGNAME,DGSSN,DIFROM,VA,VAERR,XMTEXT,XMSUB,XMDUZ

 S DGMGRP=$O(^XMB(3.8,"B","DGEN ELIGIBILITY ALERT",""))

 Q:'DGMGRP

 I $$FMTE^XLFDT($G(DODREJDT))="" Q

 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="Date of Death Transmission Error"

 S XMDUZ="DEATH TRANSMISSION TO STATION #"_$P($$SITE^VASITE,"^")

 S DGLINE=0

 D LINE^DGEN("A Death Demographic (ORU~Z05) HL7 Message was received",.DGLINE)

 D LINE^DGEN("at Station #"_$P($$SITE^VASITE,"^")_" for the following patient:",.DGLINE)

 D LINE^DGEN("",.DGLINE)

 D LINE^DGEN("         Name: "_$P($$PT^IVMUFNC4(DFN),"^"),.DGLINE)

 D LINE^DGEN("          SSN: "_$P($G(^DPT(DFN,0)),"^",9),.DGLINE)

 D LINE^DGEN("          DOB: "_$$FMTE^XLFDT($P($G(^DPT(DFN,0)),"^",3)),.DGLINE)

 D LINE^DGEN("          DOD: "_$$FMTE^XLFDT($G(DODREJDT)),.DGLINE)

 D LINE^DGEN("",.DGLINE)

 D LINE^DGEN("The veteran is an inpatient at this site. Please",.DGLINE)

 D LINE^DGEN("remove the Date of Death information for this veteran.",.DGLINE)

 D LINE^DGEN("",.DGLINE)

 D ^XMD

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMLDEMB   2094     printed  Mar 13, 2025@21:05:54                                                                                                                                                                                                    Page 2

IVMLDEMB  ;ALB/PHH - IVM DEMOGRAPHIC UPLOAD FILE DATE OF DEATH FIELDS ; 04/17/2009

 +1       ;;2.0;INCOME VERIFICATION MATCH;**131**; 21-OCT-94;Build 2

 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.

 +3       ;

 +4        QUIT

CKINPAT(DFN) ; Check if InPatient

 +1       ; Function returns 1 if yes, 0 if no

 +2        NEW RETVAL

 +3        SET RETVAL=0

 +4        SET RETVAL=$$CURINPAT^DGENPTA(DFN)

 +5        QUIT RETVAL

AUTOREJ   ; Auto Reject a DOD

 +1       ; - loop through DOD fields

 +2        FOR DODFIELD="ZPD09","ZPD31","ZPD32"

               Begin DoDot:1

 +3                SET IVMI=$ORDER(^IVM(301.92,"C",DODFIELD,""))

                   IF IVMI=""

                       QUIT

 +4                SET IVMJ=$ORDER(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM","B",IVMI,""))

                   if IVMJ']""

                       QUIT

                   Begin DoDot:2

 +5       ;

 +6       ; - check for data node in (#301.511) sub-file

 +7                    SET IVMNODE=$GET(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM",IVMJ,0))

                       if '(+IVMNODE)

                           QUIT

 +8       ;

 +9                    IF DODFIELD="ZPD09"

                           Begin DoDot:3

 +10                           SET DODREJDT=$PIECE(IVMNODE,"^",2)

                           End DoDot:3

 +11      ;

 +12      ; - remove entry from (#301.511) sub-file

 +13                   DO DELENT^IVMLDEMU(IVMDA2,IVMDA1,IVMJ)

                   End DoDot:2

               End DoDot:1

 +14      ;

 +15       DO CLEAN^IVMLDEMD(IVMDA2)

 +16       QUIT

SNDBULL   ; Send MailMan Bulletin to HEC to remove DOD

 +1        NEW DGBULL,DGLINE,DGMGRP,DGNAME,DGSSN,DIFROM,VA,VAERR,XMTEXT,XMSUB,XMDUZ

 +2        SET DGMGRP=$ORDER(^XMB(3.8,"B","DGEN ELIGIBILITY ALERT",""))

 +3        if 'DGMGRP

               QUIT

 +4        IF $$FMTE^XLFDT($GET(DODREJDT))=""

               QUIT

 +5        DO XMY^DGMTUTL(DGMGRP,0,1)

 +6        SET DGNAME=$PIECE($GET(^DPT(DFN,0)),"^")

           SET DGSSN=$PIECE($GET(^DPT(DFN,0)),"^",9)

 +7        SET XMTEXT="DGBULL("

 +8        SET XMSUB="Date of Death Transmission Error"

 +9        SET XMDUZ="DEATH TRANSMISSION TO STATION #"_$PIECE($$SITE^VASITE,"^")

 +10       SET DGLINE=0

 +11       DO LINE^DGEN("A Death Demographic (ORU~Z05) HL7 Message was received",.DGLINE)

 +12       DO LINE^DGEN("at Station #"_$PIECE($$SITE^VASITE,"^")_" for the following patient:",.DGLINE)

 +13       DO LINE^DGEN("",.DGLINE)

 +14       DO LINE^DGEN("         Name: "_$PIECE($$PT^IVMUFNC4(DFN),"^"),.DGLINE)

 +15       DO LINE^DGEN("          SSN: "_$PIECE($GET(^DPT(DFN,0)),"^",9),.DGLINE)

 +16       DO LINE^DGEN("          DOB: "_$$FMTE^XLFDT($PIECE($GET(^DPT(DFN,0)),"^",3)),.DGLINE)

 +17       DO LINE^DGEN("          DOD: "_$$FMTE^XLFDT($GET(DODREJDT)),.DGLINE)

 +18       DO LINE^DGEN("",.DGLINE)

 +19       DO LINE^DGEN("The veteran is an inpatient at this site. Please",.DGLINE)

 +20       DO LINE^DGEN("remove the Date of Death information for this veteran.",.DGLINE)

 +21       DO LINE^DGEN("",.DGLINE)

 +22       DO ^XMD

 +23       QUIT

IVMLDEMB.m