source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCAMDTH.m@ 1556

Last change on this file since 1556 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.4 KB
RevLine 
[613]1RCAMDTH ;WASH-ISC@ALTOONA,PA/LDB-DEATH NOTIFICATION FOR ACCOUNTS RECEIVABLE ;8/30/93 4:05 PM
2V ;;4.5;Accounts Receivable;**63,159**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5SET ;SET RCLOGIC FOR PATIENT FILE (2) FIELD .351 DATE OF DEATH ENTERED
6 N DFN,RCLOGIC,VADM S RCLOGIC=1
7 S DFN=+DA D DEM^VADPT
8 I '+VADM(6) Q
9 ;
10MAIL 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
11 K ^TMP($J,"RCAMDTH")
12 I '$G(DA) Q
13 I ('$D(^PRCA(430,"E",+DA)))&('$D(^RCD(340,"B",+DA_";DPT("))) Q
14 S RCDB=+$O(^RCD(340,"B",+DA_";DPT(",0))
15 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)
16 Q:'$O(RCST(0))
17 S ^TMP($J,"RCAMDTH",1)=" "
18 S ^TMP($J,"RCAMDTH",2)=" PATIENT NAME: "_$P(VADM(1),"^")
19 S ^TMP($J,"RCAMDTH",3)=" SSN: "_$P(VADM(2),"^",2)
20 S ^TMP($J,"RCAMDTH",4)=" "
21 S ^TMP($J,"RCAMDTH",5)="DATE OF DEATH: "_$S(RCLOGIC=1:$P(VADM(6),"^",2),2:"DELETED")
22 S ^TMP($J,"RCAMDTH",6)=" "
23 S ^TMP($J,"RCAMDTH",7)=" "
24 S ^TMP($J,"RCAMDTH",8)="==============================================================================="
25 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."
26 S ^TMP($J,"RCAMDTH",10)="A review of the patient's account may be necessary for follow-up action."
27 S ^TMP($J,"RCAMDTH",11)="The following bills are either Active, Open or Suspended for this patient:"
28 S ^TMP($J,"RCAMDTH",12)=" "
29 S ^TMP($J,"RCAMDTH",13)=" BILL NO. AMOUNT STATUS"
30 S ^TMP($J,"RCAMDTH",14)=" --------- ------ ------"
31 S ^TMP($J,"RCAMDTH",15)=" "
32 S RCLN=15
33 ;
34 ; -Check for bills Open Active or Suspended
35 I RCDB F RCST=102,112,240 D
36 .S RCBN=0 F S RCBN=$O(^PRCA(430,"AS",RCDB,+RCST(RCST),RCBN)) Q:'RCBN D
37 ..S RCCB=0 F RCY=1:1:5 S RCCB=$P($G(^PRCA(430,+RCBN,7)),"^",RCY)+RCCB
38 ..S RCLN=RCLN+1
39 ..S RCHD=" " I $$HD^RCRCUIB(RCBN) S (RCHDM,RCHD)="*"
40 ..S ^TMP($J,"RCAMDTH",RCLN)=" "_$P($G(^PRCA(430,+RCBN,0)),U,1)_RCHD_$J(RCCB,14,2)_" "_$P(RCST(RCST),U,2)
41 ;
42 I $G(RCHDM)="*" D
43 .F RCY=1:1:2 S RCLN=RCLN+1,^TMP($J,"RCAMDTH",RCLN)=" "
44 .S RCLN=RCLN+1,^TMP($J,"RCAMDTH",RCLN)=" * - Indicates Cat C Charges on Hold"
45 ;
46 ; -Check for Referred bills to RC
47 S RCBN=0 F S RCBN=$O(^PRCA(430,"E",+DFN,RCBN)) Q:('RCBN)!($G(RCRF)=1) D
48 .I '$$REFST^RCRCUTL(RCBN) Q
49 .;Set up information for the Divisions of care.
50 . S RCSITE=$$SITE^RCMSITE
51 . D RCDIV^RCRCDIV(.RCDIV)
52 .;S RCRF=1 S RCDOM=$$RCDOM^RCRCUTL()
53 . S RCRF=1
54 . I $O(RCDIV(0)) S RCBDIV=$$DIV^IBJDF2(RCBN) S X=0 F S X=$O(RCDIV(X)) Q:'X D
55 ..I X=+RCBDIV S RCDOM=$P(RCDIV(X),U,7)
56 ..Q
57 .I $G(RCDOM)="" D
58 ..S X=$O(^RCT(349.1,"B","RC",0))
59 ..S RCDOM=$P($G(^RCT(349.1,+X,3)),U,5)
60 ..Q
61 .F RCY=1:1:2 S RCLN=RCLN+1,^TMP($J,"RCAMDTH",RCLN)=" "
62 .S RCLN=RCLN+1,^TMP($J,"RCAMDTH",RCLN)=" (Patient has referred Third Party bills. Notification forwarded to RC.)"
63 ;
64 ; -If no bills found Quit
65 I RCLN=15 G MAILQ
66 ;
67 S XMY("G.PRCA ADJUSTMENT TRANS")="",XMCHAN=1
68 I $G(RCRF),$G(RCDOM)]"" S RCD=RCDOM S XMY(RCD)=""
69 S XMSUB=$S(RCLOGIC=1:"NOTIFICATION OF DEATH ENTRY",1:"DATE OF DEATH DELETED")
70 S XMTEXT="^TMP($J,""RCAMDTH"",",XMDUZ="AR Package"
71 D ^XMD
72MAILQ K ^TMP($J,"RCAMDTH")
73 Q
74 ;
75ERR ;Called from the DATE OF DEATH field (.351) in the PATIENT FILE (#2)
76 ;Date of Death Deleted
77 N DFN,RCLOGIC,VADM
78 S DFN=+DA D DEM^VADPT
79 I '+VADM(6) S RCLOGIC=2 D MAIL
80 Q
Note: See TracBrowser for help on using the repository browser.