RCBEIB ;WISC/RFJ-integrated billing entry points ;1 Jun 00
;;4.5;Accounts Receivable;**157,270,301**;Mar 20, 1995;Build 144
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
; PRCA*4.5*270 add CRD flag
; CANCEL(RCBILLDA,RCCANDAT,RCCANDUZ,RCCANAMT,RCCANCOM) ; this entry point is
CANCEL(RCBILLDA,RCCANDAT,RCCANDUZ,RCCANAMT,RCCANCOM,RCCRD) ; this entry point is
; called when a bill is cancelled in IB
; input rcbillda = ien of bill to cancel
; rccandat = (optional) the date the bill was cancelled
; rccanduz = (optional) the user cancelling the bill
; rccanamt = (optional) amount being cancelled
; rccancom = (optional) comments
; rccrd = (optional) CRD flag, indicates corrected record which FMS must handle differently
;
; if the optional fields are passed, they will be stored in the
; comment field (98) of the bill.
;
; returns 1 if bill is cancelled in AR
; 0^error message if process fails to cancel bill in AR
;
N ACTDATE,COMMENT,DATA,INTADM,LINE,PIECE,RCBALANC,RCDATA0,RCDATE,RCFCANC,RCLIST,RCOMMENT,RCPAYAMT,RCPAYMNT,RCTRANDA,VALUE,X,XMDUN,XMY,Y
;
; lock the bill
L +^PRCA(430,RCBILLDA):10
I '$T Q "0^AR bill is locked by another process"
;
S RCDATA0=$G(^PRCA(430,RCBILLDA,0))
I RCDATA0="" L -^PRCA(430,RCBILLDA) Q "0^AR bill not found"
;
; add comments to bill
S RCOMMENT(1)="Bill was cancelled in IB on "_$$FMTE^XLFDT($$NOW^XLFDT)_".",LINE=2
S Y=$G(RCCANDAT) I Y S Y=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3),LINE=LINE+1,RCOMMENT(LINE)=" Cancel Date: "_Y
S Y=$G(RCCANDUZ) I Y S Y=$P($G(^VA(200,+RCCANDUZ,0)),"^"),LINE=LINE+1,RCOMMENT(LINE)=" Cancel By: "_Y
S Y=$G(RCCANAMT) I Y S Y=$J(Y,0,2),LINE=LINE+1,RCOMMENT(LINE)=" Cancel Amount: "_Y
I $G(RCCANCOM)'="" S LINE=LINE+1,RCOMMENT(LINE)=" Comments: "_RCCANCOM
I LINE'=2 S RCOMMENT(2)="The following information was passed from IB:"
D ADDCOMM^RCBEUBIL(RCBILLDA,.RCOMMENT)
;
; test to see if the bill is active in AR
S ACTDATE=$P($G(^PRCA(430,RCBILLDA,6)),"^",21)
;
; === bill not activated ===
; set status to cancelled bill (26)
I 'ACTDATE D CHGSTAT^RCBEUBIL(RCBILLDA,26) L -^PRCA(430,RCBILLDA) Q 1
;
; === bill is activated ===
;
; get the balance of the bill
S RCBALANC=$$GETTRANS^RCDPBTLM(RCBILLDA)
;
; calculate payments made
S RCDATE="",RCPAYAMT=0,RCPAYMNT=""
F S RCDATE=$O(RCLIST(RCDATE)) Q:'RCDATE D
. S RCTRANDA=0
. F S RCTRANDA=$O(RCLIST(RCDATE,RCTRANDA)) Q:'RCTRANDA D
. . I RCLIST(RCDATE,RCTRANDA)'["PAYMENT" Q
. . F PIECE=2:1:6 D
. . . ; total payments
. . . S RCPAYAMT=RCPAYAMT+$P(RCLIST(RCDATE,RCTRANDA),"^",PIECE)
. . . ; total payments by prin ^ int ^ adm ^ mf ^ cc
. . . S $P(RCPAYMNT,"^",PIECE-1)=$P(RCPAYMNT,"^",PIECE-1)+$P(RCLIST(RCDATE,RCTRANDA),"^",PIECE)
;
; if the current bill status is active, cancel it
I $P(^PRCA(430,RCBILLDA,0),"^",8)=16!($P(^PRCA(430,RCBILLDA,0),"^",8)=42) D
. ; if there is a principal balance, decrease it
. S COMMENT(1)="Bill cancelled in IB. Automatic decrease adjustment created."
. ;
. ; PRCA*4.5*270 need to let FMS know if this is a corrected record
. ;I $P(RCBALANC,"^") S RCTRANDA=$$INCDEC^RCBEUTR1(RCBILLDA,-$P(RCBALANC,"^"),.COMMENT) I 'RCTRANDA Q
. I $P(RCBALANC,"^") S RCTRANDA=$$INCDEC^RCBEUTR1(RCBILLDA,-$P(RCBALANC,"^"),.COMMENT,"","","",$G(RCCRD)) I 'RCTRANDA Q
. I $D(^PRCA(430,"TCSP",RCBILLDA)) D DECADJ^RCTCSPU(RCBILLDA,RCTRANDA) ;prca*4.5*301 add cs decrease adjustment
. ;
. ; create an int/adm charge (minus)
. ; determine if there is an interest ^ admin ^ mf ^ cc charge
. ; set value = interest ^ admin ^ mf ^ cc (and make negative)
. S INTADM=0,VALUE=""
. F PIECE=2:1:5 S INTADM=INTADM+$P(RCBALANC,"^",PIECE),VALUE=VALUE_(-$P(RCBALANC,"^",PIECE))_"^"
. I INTADM S RCTRANDA=$$INTADM^RCBEUTR1(RCBILLDA,VALUE,.COMMENT) I 'RCTRANDA Q
. I $D(^PRCA(430,"TCSP",RCBILLDA)) D DECADJ^RCTCSPU(RCBILLDA,RCTRANDA) ;prca*4.5*301 add cs decrease adjustment
. ;
. ; mark bill as cancellation (39)
. D CHGSTAT^RCBEUBIL(RCBILLDA,39)
;
; recheck status to see if bill was cancelled
; set rcfcanc to indicate bill could not be canceled
S RCDATA0=$G(^PRCA(430,RCBILLDA,0))
I $P(RCDATA0,"^",8)'=39,$P(RCDATA0,"^",8)'=26 S RCFCANC="AR could not automatically CANCEL the bill. User action is required."
;
; if the bill was cancelled in AR and no payments, do not send mail
I $G(RCFCANC)="",'RCPAYAMT L -^PRCA(430,RCBILLDA) Q 1
;
;
; bill could not be cancelled in AR or payments made,
; send mailman message to user
K ^TMP($J,"RCRJRCORMM")
S ^TMP($J,"RCRJRCORMM",1,0)="Integrated Billing has cancelled bill "_$P(RCDATA0,"^")_"."
S ^TMP($J,"RCRJRCORMM",2,0)=" "
S ^TMP($J,"RCRJRCORMM",3,0)=" BILL: "_$P(RCDATA0,"^")_" STATUS: "_$P($G(^PRCA(430.3,+$P(^PRCA(430,RCBILLDA,0),"^",8),0)),"^")
S DATA=$$ACCNTHDR^RCDPAPLM($P(RCDATA0,"^",9))
S ^TMP($J,"RCRJRCORMM",4,0)=" ACCOUNT: "_$P(DATA,"^")_" "_$P(DATA,"^",2)
S ^TMP($J,"RCRJRCORMM",5,0)=" "
S ^TMP($J,"RCRJRCORMM",6,0)=" Principal Interest Admin"
S ^TMP($J,"RCRJRCORMM",7,0)=" Current Balance: "_$J($P(RCBALANC,"^"),10,2)_$J($P(RCBALANC,"^",2),10,2)_$J($P(RCBALANC,"^",3)+$P(RCBALANC,"^",4)+$P(RCBALANC,"^",5),10,2)
S LINE=7
;
; if payments made, show amount paid
I RCPAYAMT S LINE=LINE+1,^TMP($J,"RCRJRCORMM",LINE,0)=" Payments Made: "_$J(-$P(RCPAYMNT,"^"),10,2)_$J(-$P(RCPAYMNT,"^",2),10,2)_$J(-$P(RCPAYMNT,"^",3)-$P(RCPAYMNT,"^",4)-$P(RCPAYMNT,"^",5),10,2)
;
; if comments passed from IB, include them
I $D(RCOMMENT(2)) D
. S LINE=LINE+1,^TMP($J,"RCRJRCORMM",LINE,0)=" "
. F X=1:1 Q:'$D(RCOMMENT(X)) S LINE=LINE+1,^TMP($J,"RCRJRCORMM",LINE,0)=RCOMMENT(X)
;
; if the bill could not be cancelled in AR, let user know the error
I $G(RCFCANC)'="" D
. S LINE=LINE+1,^TMP($J,"RCRJRCORMM",LINE,0)=" "
. S LINE=LINE+1,^TMP($J,"RCRJRCORMM",LINE,0)="* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *"
. S LINE=LINE+1,^TMP($J,"RCRJRCORMM",LINE,0)=RCFCANC
. S LINE=LINE+1,^TMP($J,"RCRJRCORMM",LINE,0)="* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *"
;
; if a payment has been made, let user know it needs to be refunded
I RCPAYAMT D
. S LINE=LINE+1,^TMP($J,"RCRJRCORMM",LINE,0)=" "
. S LINE=LINE+1,^TMP($J,"RCRJRCORMM",LINE,0)="* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *"
. S LINE=LINE+1,^TMP($J,"RCRJRCORMM",LINE,0)="In AR, a payment of $ "_$J(-RCPAYAMT,0,2)_" has been collected and needs to be REFUNDED."
. S LINE=LINE+1,^TMP($J,"RCRJRCORMM",LINE,0)="* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *"
;
; send report
S XMY("G.PRCA ADJUSTMENT TRANS")=""
S X=$$SENDMSG^RCRJRCOR("AR User Action Required "_$P(RCDATA0,"^"),.XMY)
K ^TMP($J,"RCRJRCORMM")
;
L -^PRCA(430,RCBILLDA)
;
Q $S($G(RCFCANC)'="":"0^"_RCFCANC,1:1)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCBEIB 7165 printed Dec 13, 2024@01:42:45 Page 2
RCBEIB ;WISC/RFJ-integrated billing entry points ;1 Jun 00
+1 ;;4.5;Accounts Receivable;**157,270,301**;Mar 20, 1995;Build 144
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;
+5 ; PRCA*4.5*270 add CRD flag
+6 ; CANCEL(RCBILLDA,RCCANDAT,RCCANDUZ,RCCANAMT,RCCANCOM) ; this entry point is
CANCEL(RCBILLDA,RCCANDAT,RCCANDUZ,RCCANAMT,RCCANCOM,RCCRD) ; this entry point is
+1 ; called when a bill is cancelled in IB
+2 ; input rcbillda = ien of bill to cancel
+3 ; rccandat = (optional) the date the bill was cancelled
+4 ; rccanduz = (optional) the user cancelling the bill
+5 ; rccanamt = (optional) amount being cancelled
+6 ; rccancom = (optional) comments
+7 ; rccrd = (optional) CRD flag, indicates corrected record which FMS must handle differently
+8 ;
+9 ; if the optional fields are passed, they will be stored in the
+10 ; comment field (98) of the bill.
+11 ;
+12 ; returns 1 if bill is cancelled in AR
+13 ; 0^error message if process fails to cancel bill in AR
+14 ;
+15 NEW ACTDATE,COMMENT,DATA,INTADM,LINE,PIECE,RCBALANC,RCDATA0,RCDATE,RCFCANC,RCLIST,RCOMMENT,RCPAYAMT,RCPAYMNT,RCTRANDA,VALUE,X,XMDUN,XMY,Y
+16 ;
+17 ; lock the bill
+18 LOCK +^PRCA(430,RCBILLDA):10
+19 IF '$TEST
QUIT "0^AR bill is locked by another process"
+20 ;
+21 SET RCDATA0=$GET(^PRCA(430,RCBILLDA,0))
+22 IF RCDATA0=""
LOCK -^PRCA(430,RCBILLDA)
QUIT "0^AR bill not found"
+23 ;
+24 ; add comments to bill
+25 SET RCOMMENT(1)="Bill was cancelled in IB on "_$$FMTE^XLFDT($$NOW^XLFDT)_"."
SET LINE=2
+26 SET Y=$GET(RCCANDAT)
IF Y
SET Y=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3)
SET LINE=LINE+1
SET RCOMMENT(LINE)=" Cancel Date: "_Y
+27 SET Y=$GET(RCCANDUZ)
IF Y
SET Y=$PIECE($GET(^VA(200,+RCCANDUZ,0)),"^")
SET LINE=LINE+1
SET RCOMMENT(LINE)=" Cancel By: "_Y
+28 SET Y=$GET(RCCANAMT)
IF Y
SET Y=$JUSTIFY(Y,0,2)
SET LINE=LINE+1
SET RCOMMENT(LINE)=" Cancel Amount: "_Y
+29 IF $GET(RCCANCOM)'=""
SET LINE=LINE+1
SET RCOMMENT(LINE)=" Comments: "_RCCANCOM
+30 IF LINE'=2
SET RCOMMENT(2)="The following information was passed from IB:"
+31 DO ADDCOMM^RCBEUBIL(RCBILLDA,.RCOMMENT)
+32 ;
+33 ; test to see if the bill is active in AR
+34 SET ACTDATE=$PIECE($GET(^PRCA(430,RCBILLDA,6)),"^",21)
+35 ;
+36 ; === bill not activated ===
+37 ; set status to cancelled bill (26)
+38 IF 'ACTDATE
DO CHGSTAT^RCBEUBIL(RCBILLDA,26)
LOCK -^PRCA(430,RCBILLDA)
QUIT 1
+39 ;
+40 ; === bill is activated ===
+41 ;
+42 ; get the balance of the bill
+43 SET RCBALANC=$$GETTRANS^RCDPBTLM(RCBILLDA)
+44 ;
+45 ; calculate payments made
+46 SET RCDATE=""
SET RCPAYAMT=0
SET RCPAYMNT=""
+47 FOR
SET RCDATE=$ORDER(RCLIST(RCDATE))
if 'RCDATE
QUIT
Begin DoDot:1
+48 SET RCTRANDA=0
+49 FOR
SET RCTRANDA=$ORDER(RCLIST(RCDATE,RCTRANDA))
if 'RCTRANDA
QUIT
Begin DoDot:2
+50 IF RCLIST(RCDATE,RCTRANDA)'["PAYMENT"
QUIT
+51 FOR PIECE=2:1:6
Begin DoDot:3
+52 ; total payments
+53 SET RCPAYAMT=RCPAYAMT+$PIECE(RCLIST(RCDATE,RCTRANDA),"^",PIECE)
+54 ; total payments by prin ^ int ^ adm ^ mf ^ cc
+55 SET $PIECE(RCPAYMNT,"^",PIECE-1)=$PIECE(RCPAYMNT,"^",PIECE-1)+$PIECE(RCLIST(RCDATE,RCTRANDA),"^",PIECE)
End DoDot:3
End DoDot:2
End DoDot:1
+56 ;
+57 ; if the current bill status is active, cancel it
+58 IF $PIECE(^PRCA(430,RCBILLDA,0),"^",8)=16!($PIECE(^PRCA(430,RCBILLDA,0),"^",8)=42)
Begin DoDot:1
+59 ; if there is a principal balance, decrease it
+60 SET COMMENT(1)="Bill cancelled in IB. Automatic decrease adjustment created."
+61 ;
+62 ; PRCA*4.5*270 need to let FMS know if this is a corrected record
+63 ;I $P(RCBALANC,"^") S RCTRANDA=$$INCDEC^RCBEUTR1(RCBILLDA,-$P(RCBALANC,"^"),.COMMENT) I 'RCTRANDA Q
+64 IF $PIECE(RCBALANC,"^")
SET RCTRANDA=$$INCDEC^RCBEUTR1(RCBILLDA,-$PIECE(RCBALANC,"^"),.COMMENT,"","","",$GET(RCCRD))
IF 'RCTRANDA
QUIT
+65 ;prca*4.5*301 add cs decrease adjustment
IF $DATA(^PRCA(430,"TCSP",RCBILLDA))
DO DECADJ^RCTCSPU(RCBILLDA,RCTRANDA)
+66 ;
+67 ; create an int/adm charge (minus)
+68 ; determine if there is an interest ^ admin ^ mf ^ cc charge
+69 ; set value = interest ^ admin ^ mf ^ cc (and make negative)
+70 SET INTADM=0
SET VALUE=""
+71 FOR PIECE=2:1:5
SET INTADM=INTADM+$PIECE(RCBALANC,"^",PIECE)
SET VALUE=VALUE_(-$PIECE(RCBALANC,"^",PIECE))_"^"
+72 IF INTADM
SET RCTRANDA=$$INTADM^RCBEUTR1(RCBILLDA,VALUE,.COMMENT)
IF 'RCTRANDA
QUIT
+73 ;prca*4.5*301 add cs decrease adjustment
IF $DATA(^PRCA(430,"TCSP",RCBILLDA))
DO DECADJ^RCTCSPU(RCBILLDA,RCTRANDA)
+74 ;
+75 ; mark bill as cancellation (39)
+76 DO CHGSTAT^RCBEUBIL(RCBILLDA,39)
End DoDot:1
+77 ;
+78 ; recheck status to see if bill was cancelled
+79 ; set rcfcanc to indicate bill could not be canceled
+80 SET RCDATA0=$GET(^PRCA(430,RCBILLDA,0))
+81 IF $PIECE(RCDATA0,"^",8)'=39
IF $PIECE(RCDATA0,"^",8)'=26
SET RCFCANC="AR could not automatically CANCEL the bill. User action is required."
+82 ;
+83 ; if the bill was cancelled in AR and no payments, do not send mail
+84 IF $GET(RCFCANC)=""
IF 'RCPAYAMT
LOCK -^PRCA(430,RCBILLDA)
QUIT 1
+85 ;
+86 ;
+87 ; bill could not be cancelled in AR or payments made,
+88 ; send mailman message to user
+89 KILL ^TMP($JOB,"RCRJRCORMM")
+90 SET ^TMP($JOB,"RCRJRCORMM",1,0)="Integrated Billing has cancelled bill "_$PIECE(RCDATA0,"^")_"."
+91 SET ^TMP($JOB,"RCRJRCORMM",2,0)=" "
+92 SET ^TMP($JOB,"RCRJRCORMM",3,0)=" BILL: "_$PIECE(RCDATA0,"^")_" STATUS: "_$PIECE($GET(^PRCA(430.3,+$PIECE(^PRCA(430,RCBILLDA,0),"^",8),0)),"^")
+93 SET DATA=$$ACCNTHDR^RCDPAPLM($PIECE(RCDATA0,"^",9))
+94 SET ^TMP($JOB,"RCRJRCORMM",4,0)=" ACCOUNT: "_$PIECE(DATA,"^")_" "_$PIECE(DATA,"^",2)
+95 SET ^TMP($JOB,"RCRJRCORMM",5,0)=" "
+96 SET ^TMP($JOB,"RCRJRCORMM",6,0)=" Principal Interest Admin"
+97 SET ^TMP($JOB,"RCRJRCORMM",7,0)=" Current Balance: "_$JUSTIFY($PIECE(RCBALANC,"^"),10,2)_$JUSTIFY($PIECE(RCBALANC,"^",2),10,2)_$JUSTIFY($PIECE(RCBALANC,"^",3)+$PIECE(RCBALANC,"^",4)+$PIECE(RCBALANC,"^",5),10,2)
+98 SET LINE=7
+99 ;
+100 ; if payments made, show amount paid
+101 IF RCPAYAMT
SET LINE=LINE+1
SET ^TMP($JOB,"RCRJRCORMM",LINE,0)=" Payments Made: "_$JUSTIFY(-$PIECE(RCPAYMNT,"^"),10,2)_$JUSTIFY(-$PIECE(RCPAYMNT,"^",2),10,2)_$JUSTIFY(-$PIECE(RCPAYMNT,"^",3)-$PIECE(RCPAYMNT,"^",4)-$PIECE(RCPAYMNT,"^",5),10,2)
+102 ;
+103 ; if comments passed from IB, include them
+104 IF $DATA(RCOMMENT(2))
Begin DoDot:1
+105 SET LINE=LINE+1
SET ^TMP($JOB,"RCRJRCORMM",LINE,0)=" "
+106 FOR X=1:1
if '$DATA(RCOMMENT(X))
QUIT
SET LINE=LINE+1
SET ^TMP($JOB,"RCRJRCORMM",LINE,0)=RCOMMENT(X)
End DoDot:1
+107 ;
+108 ; if the bill could not be cancelled in AR, let user know the error
+109 IF $GET(RCFCANC)'=""
Begin DoDot:1
+110 SET LINE=LINE+1
SET ^TMP($JOB,"RCRJRCORMM",LINE,0)=" "
+111 SET LINE=LINE+1
SET ^TMP($JOB,"RCRJRCORMM",LINE,0)="* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *"
+112 SET LINE=LINE+1
SET ^TMP($JOB,"RCRJRCORMM",LINE,0)=RCFCANC
+113 SET LINE=LINE+1
SET ^TMP($JOB,"RCRJRCORMM",LINE,0)="* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *"
End DoDot:1
+114 ;
+115 ; if a payment has been made, let user know it needs to be refunded
+116 IF RCPAYAMT
Begin DoDot:1
+117 SET LINE=LINE+1
SET ^TMP($JOB,"RCRJRCORMM",LINE,0)=" "
+118 SET LINE=LINE+1
SET ^TMP($JOB,"RCRJRCORMM",LINE,0)="* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *"
+119 SET LINE=LINE+1
SET ^TMP($JOB,"RCRJRCORMM",LINE,0)="In AR, a payment of $ "_$JUSTIFY(-RCPAYAMT,0,2)_" has been collected and needs to be REFUNDED."
+120 SET LINE=LINE+1
SET ^TMP($JOB,"RCRJRCORMM",LINE,0)="* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *"
End DoDot:1
+121 ;
+122 ; send report
+123 SET XMY("G.PRCA ADJUSTMENT TRANS")=""
+124 SET X=$$SENDMSG^RCRJRCOR("AR User Action Required "_$PIECE(RCDATA0,"^"),.XMY)
+125 KILL ^TMP($JOB,"RCRJRCORMM")
+126 ;
+127 LOCK -^PRCA(430,RCBILLDA)
+128 ;
+129 QUIT $SELECT($GET(RCFCANC)'="":"0^"_RCFCANC,1:1)
