RCAMDTH ;WASH-ISC@ALTOONA,PA/LDB-DEATH NOTIFICATION FOR ACCOUNTS RECEIVABLE ;8/30/93 4:05 PM
V ;;4.5;Accounts Receivable;**63,159**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
SET ;SET RCLOGIC FOR PATIENT FILE (2) FIELD .351 DATE OF DEATH ENTERED
N DFN,RCLOGIC,VADM S RCLOGIC=1
S DFN=+DA D DEM^VADPT
I '+VADM(6) Q
;
MAIL N RCCB,RCBDIV,RCBN,RCDB,RCD,RCDIV,RCDOM,RCHD,RCHDM,RCLN,RCRF,RCSITE,RCST,RCY,VA,VAERR,X,XMCHAN,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,Y
K ^TMP($J,"RCAMDTH")
I '$G(DA) Q
I ('$D(^PRCA(430,"E",+DA)))&('$D(^RCD(340,"B",+DA_";DPT("))) Q
S RCDB=+$O(^RCD(340,"B",+DA_";DPT(",0))
F RCST=102,112,240 S RCST(RCST)=$O(^PRCA(430.3,"AC",RCST,0)) S $P(RCST(RCST),U,2)=$P($G(^PRCA(430.3,+RCST(RCST),0)),U,1)
Q:'$O(RCST(0))
S ^TMP($J,"RCAMDTH",1)=" "
S ^TMP($J,"RCAMDTH",2)=" PATIENT NAME: "_$P(VADM(1),"^")
S ^TMP($J,"RCAMDTH",3)=" SSN: "_$P(VADM(2),"^",2)
S ^TMP($J,"RCAMDTH",4)=" "
S ^TMP($J,"RCAMDTH",5)="DATE OF DEATH: "_$S(RCLOGIC=1:$P(VADM(6),"^",2),2:"DELETED")
S ^TMP($J,"RCAMDTH",6)=" "
S ^TMP($J,"RCAMDTH",7)=" "
S ^TMP($J,"RCAMDTH",8)="==============================================================================="
S ^TMP($J,"RCAMDTH",9)="Please note that MAS has "_$S(RCLOGIC=1:"entered a ",1:"DELETED the ")_"DATE OF DEATH for the above patient."
S ^TMP($J,"RCAMDTH",10)="A review of the patient's account may be necessary for follow-up action."
S ^TMP($J,"RCAMDTH",11)="The following bills are either Active, Open or Suspended for this patient:"
S ^TMP($J,"RCAMDTH",12)=" "
S ^TMP($J,"RCAMDTH",13)=" BILL NO. AMOUNT STATUS"
S ^TMP($J,"RCAMDTH",14)=" --------- ------ ------"
S ^TMP($J,"RCAMDTH",15)=" "
S RCLN=15
;
; -Check for bills Open Active or Suspended
I RCDB F RCST=102,112,240 D
.S RCBN=0 F S RCBN=$O(^PRCA(430,"AS",RCDB,+RCST(RCST),RCBN)) Q:'RCBN D
..S RCCB=0 F RCY=1:1:5 S RCCB=$P($G(^PRCA(430,+RCBN,7)),"^",RCY)+RCCB
..S RCLN=RCLN+1
..S RCHD=" " I $$HD^RCRCUIB(RCBN) S (RCHDM,RCHD)="*"
..S ^TMP($J,"RCAMDTH",RCLN)=" "_$P($G(^PRCA(430,+RCBN,0)),U,1)_RCHD_$J(RCCB,14,2)_" "_$P(RCST(RCST),U,2)
;
I $G(RCHDM)="*" D
.F RCY=1:1:2 S RCLN=RCLN+1,^TMP($J,"RCAMDTH",RCLN)=" "
.S RCLN=RCLN+1,^TMP($J,"RCAMDTH",RCLN)=" * - Indicates Cat C Charges on Hold"
;
; -Check for Referred bills to RC
S RCBN=0 F S RCBN=$O(^PRCA(430,"E",+DFN,RCBN)) Q:('RCBN)!($G(RCRF)=1) D
.I '$$REFST^RCRCUTL(RCBN) Q
.;Set up information for the Divisions of care.
. S RCSITE=$$SITE^RCMSITE
. D RCDIV^RCRCDIV(.RCDIV)
.;S RCRF=1 S RCDOM=$$RCDOM^RCRCUTL()
. S RCRF=1
. I $O(RCDIV(0)) S RCBDIV=$$DIV^IBJDF2(RCBN) S X=0 F S X=$O(RCDIV(X)) Q:'X D
..I X=+RCBDIV S RCDOM=$P(RCDIV(X),U,7)
..Q
.I $G(RCDOM)="" D
..S X=$O(^RCT(349.1,"B","RC",0))
..S RCDOM=$P($G(^RCT(349.1,+X,3)),U,5)
..Q
.F RCY=1:1:2 S RCLN=RCLN+1,^TMP($J,"RCAMDTH",RCLN)=" "
.S RCLN=RCLN+1,^TMP($J,"RCAMDTH",RCLN)=" (Patient has referred Third Party bills. Notification forwarded to RC.)"
;
; -If no bills found Quit
I RCLN=15 G MAILQ
;
S XMY("G.PRCA ADJUSTMENT TRANS")="",XMCHAN=1
I $G(RCRF),$G(RCDOM)]"" S RCD=RCDOM S XMY(RCD)=""
S XMSUB=$S(RCLOGIC=1:"NOTIFICATION OF DEATH ENTRY",1:"DATE OF DEATH DELETED")
S XMTEXT="^TMP($J,""RCAMDTH"",",XMDUZ="AR Package"
D ^XMD
MAILQ K ^TMP($J,"RCAMDTH")
Q
;
ERR ;Called from the DATE OF DEATH field (.351) in the PATIENT FILE (#2)
;Date of Death Deleted
N DFN,RCLOGIC,VADM
S DFN=+DA D DEM^VADPT
I '+VADM(6) S RCLOGIC=2 D MAIL
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCAMDTH 3570 printed Apr 09, 2024@20:49:27 Page 2
RCAMDTH ;WASH-ISC@ALTOONA,PA/LDB-DEATH NOTIFICATION FOR ACCOUNTS RECEIVABLE ;8/30/93 4:05 PM
V ;;4.5;Accounts Receivable;**63,159**;Mar 20, 1995
+1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;
SET ;SET RCLOGIC FOR PATIENT FILE (2) FIELD .351 DATE OF DEATH ENTERED
+1 NEW DFN,RCLOGIC,VADM
SET RCLOGIC=1
+2 SET DFN=+DA
DO DEM^VADPT
+3 IF '+VADM(6)
QUIT
+4 ;
MAIL NEW RCCB,RCBDIV,RCBN,RCDB,RCD,RCDIV,RCDOM,RCHD,RCHDM,RCLN,RCRF,RCSITE,RCST,RCY,VA,VAERR,X,XMCHAN,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,Y
+1 KILL ^TMP($JOB,"RCAMDTH")
+2 IF '$GET(DA)
QUIT
+3 IF ('$DATA(^PRCA(430,"E",+DA)))&('$DATA(^RCD(340,"B",+DA_";DPT(")))
QUIT
+4 SET RCDB=+$ORDER(^RCD(340,"B",+DA_";DPT(",0))
+5 FOR RCST=102,112,240
SET RCST(RCST)=$ORDER(^PRCA(430.3,"AC",RCST,0))
SET $PIECE(RCST(RCST),U,2)=$PIECE($GET(^PRCA(430.3,+RCST(RCST),0)),U,1)
+6 if '$ORDER(RCST(0))
QUIT
+7 SET ^TMP($JOB,"RCAMDTH",1)=" "
+8 SET ^TMP($JOB,"RCAMDTH",2)=" PATIENT NAME: "_$PIECE(VADM(1),"^")
+9 SET ^TMP($JOB,"RCAMDTH",3)=" SSN: "_$PIECE(VADM(2),"^",2)
+10 SET ^TMP($JOB,"RCAMDTH",4)=" "
+11 SET ^TMP($JOB,"RCAMDTH",5)="DATE OF DEATH: "_$SELECT(RCLOGIC=1:$PIECE(VADM(6),"^",2),2:"DELETED")
+12 SET ^TMP($JOB,"RCAMDTH",6)=" "
+13 SET ^TMP($JOB,"RCAMDTH",7)=" "
+14 SET ^TMP($JOB,"RCAMDTH",8)="==============================================================================="
+15 SET ^TMP($JOB,"RCAMDTH",9)="Please note that MAS has "_$SELECT(RCLOGIC=1:"entered a ",1:"DELETED the ")_"DATE OF DEATH for the above patient."
+16 SET ^TMP($JOB,"RCAMDTH",10)="A review of the patient's account may be necessary for follow-up action."
+17 SET ^TMP($JOB,"RCAMDTH",11)="The following bills are either Active, Open or Suspended for this patient:"
+18 SET ^TMP($JOB,"RCAMDTH",12)=" "
+19 SET ^TMP($JOB,"RCAMDTH",13)=" BILL NO. AMOUNT STATUS"
+20 SET ^TMP($JOB,"RCAMDTH",14)=" --------- ------ ------"
+21 SET ^TMP($JOB,"RCAMDTH",15)=" "
+22 SET RCLN=15
+23 ;
+24 ; -Check for bills Open Active or Suspended
+25 IF RCDB
FOR RCST=102,112,240
Begin DoDot:1
+26 SET RCBN=0
FOR
SET RCBN=$ORDER(^PRCA(430,"AS",RCDB,+RCST(RCST),RCBN))
if 'RCBN
QUIT
Begin DoDot:2
+27 SET RCCB=0
FOR RCY=1:1:5
SET RCCB=$PIECE($GET(^PRCA(430,+RCBN,7)),"^",RCY)+RCCB
+28 SET RCLN=RCLN+1
+29 SET RCHD=" "
IF $$HD^RCRCUIB(RCBN)
SET (RCHDM,RCHD)="*"
+30 SET ^TMP($JOB,"RCAMDTH",RCLN)=" "_$PIECE($GET(^PRCA(430,+RCBN,0)),U,1)_RCHD_$JUSTIFY(RCCB,14,2)_" "_$PIECE(RCST(RCST),U,2)
End DoDot:2
End DoDot:1
+31 ;
+32 IF $GET(RCHDM)="*"
Begin DoDot:1
+33 FOR RCY=1:1:2
SET RCLN=RCLN+1
SET ^TMP($JOB,"RCAMDTH",RCLN)=" "
+34 SET RCLN=RCLN+1
SET ^TMP($JOB,"RCAMDTH",RCLN)=" * - Indicates Cat C Charges on Hold"
End DoDot:1
+35 ;
+36 ; -Check for Referred bills to RC
+37 SET RCBN=0
FOR
SET RCBN=$ORDER(^PRCA(430,"E",+DFN,RCBN))
if ('RCBN)!($GET(RCRF)=1)
QUIT
Begin DoDot:1
+38 IF '$$REFST^RCRCUTL(RCBN)
QUIT
+39 ;Set up information for the Divisions of care.
+40 SET RCSITE=$$SITE^RCMSITE
+41 DO RCDIV^RCRCDIV(.RCDIV)
+42 ;S RCRF=1 S RCDOM=$$RCDOM^RCRCUTL()
+43 SET RCRF=1
+44 IF $ORDER(RCDIV(0))
SET RCBDIV=$$DIV^IBJDF2(RCBN)
SET X=0
FOR
SET X=$ORDER(RCDIV(X))
if 'X
QUIT
Begin DoDot:2
+45 IF X=+RCBDIV
SET RCDOM=$PIECE(RCDIV(X),U,7)
+46 QUIT
End DoDot:2
+47 IF $GET(RCDOM)=""
Begin DoDot:2
+48 SET X=$ORDER(^RCT(349.1,"B","RC",0))
+49 SET RCDOM=$PIECE($GET(^RCT(349.1,+X,3)),U,5)
+50 QUIT
End DoDot:2
+51 FOR RCY=1:1:2
SET RCLN=RCLN+1
SET ^TMP($JOB,"RCAMDTH",RCLN)=" "
+52 SET RCLN=RCLN+1
SET ^TMP($JOB,"RCAMDTH",RCLN)=" (Patient has referred Third Party bills. Notification forwarded to RC.)"
End DoDot:1
+53 ;
+54 ; -If no bills found Quit
+55 IF RCLN=15
GOTO MAILQ
+56 ;
+57 SET XMY("G.PRCA ADJUSTMENT TRANS")=""
SET XMCHAN=1
+58 IF $GET(RCRF)
IF $GET(RCDOM)]""
SET RCD=RCDOM
SET XMY(RCD)=""
+59 SET XMSUB=$SELECT(RCLOGIC=1:"NOTIFICATION OF DEATH ENTRY",1:"DATE OF DEATH DELETED")
+60 SET XMTEXT="^TMP($J,""RCAMDTH"","
SET XMDUZ="AR Package"
+61 DO ^XMD
MAILQ KILL ^TMP($JOB,"RCAMDTH")
+1 QUIT
+2 ;
ERR ;Called from the DATE OF DEATH field (.351) in the PATIENT FILE (#2)
+1 ;Date of Death Deleted
+2 NEW DFN,RCLOGIC,VADM
+3 SET DFN=+DA
DO DEM^VADPT
+4 IF '+VADM(6)
SET RCLOGIC=2
DO MAIL
+5 QUIT
