Routine: RCAMDTH

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")

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCAMDTH   3570     printed  Feb 18, 2025@23:08:49                                                                                                                                                                                                     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

RCAMDTH.m