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.
;
Q
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)
Q
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
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMLDEMB 2094 printed Apr 09, 2024@21:02:47 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
