- 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 Jan 18, 2025@02:43:58 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)