RCBECHGU ;WISC/RFJ-process the charges to bill (called by rcbechgs) ;1 Jun 00
;;4.5;Accounts Receivable;**153**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
ADDCHARG ; this is called by rcbechgs and is a continuation of that routine
; variables passed to this entry point:
; rcupdate = the fm date that charges are being added
; rcdata0 = debtor file entry 0th node
;
N COMMENT,DR,RCBILLDA,RCDATA,RCDATE,RCLINE,RCTRANDA,RCTRDATE,VALUE,X
;
; for first party charges, the 433 transaction date must be 3 days
; prior to the statement date so the charges will appear on the
; patient statement (statement date is the variable rcupdate)
S RCTRDATE=RCUPDATE
I $P(RCDATA0,"^")["DPT(" S RCTRDATE=$$FMADD^XLFDT(RCUPDATE,-3)
;
S RCBILLDA=0 F S RCBILLDA=$O(^TMP("RCBECHGS",$J,"ADDCHG",RCBILLDA)) Q:'RCBILLDA D
. S RCDATA=^TMP("RCBECHGS",$J,"ADDCHG",RCBILLDA)
. ; pass the value = interest ^ admin ^ penalty
. S VALUE=+$P(RCDATA,"^",1)_"^"_$P(RCDATA,"^",2)_"^"_$P(RCDATA,"^",3)
. ; no value for interest or admin
. I '$P(VALUE,"^"),'$P(VALUE,"^",2),'$P(VALUE,"^",3) Q
. ; pass the comments, admin comment (p4) and penalty comment (p5)
. S COMMENT="",RCLINE=1
. I $P(RCDATA,"^",4)'="" S COMMENT(RCLINE)="Admin Reason: "_$P(RCDATA,"^",4),RCLINE=2
. I $P(RCDATA,"^",5)'="" S COMMENT(RCLINE)="Penalty Reason: "_$P(RCDATA,"^",5)
. ; lock the bill, this lock cannot fail
. L +^PRCA(430,RCBILLDA)
. ;
. ; add the int/admin transaction
. S RCTRANDA=$$INTADM^RCBEUTR1(RCBILLDA,VALUE,.COMMENT,RCTRDATE)
. I 'RCTRANDA L -^PRCA(430,RCBILLDA) Q
. ;
. ; set key fields in file 430
. S DR=""
. ; interest last updated
. I $P(RCDATA,"^",1) S DR=DR_".11////"_RCUPDATE_";"
. ; admin last updated
. I $P(RCDATA,"^",2) S DR=DR_".12////"_RCUPDATE_";"
. ; penalty last updated
. I $P(RCDATA,"^",3) S DR=DR_".13////"_RCUPDATE_";"
. S X=$$EDIT430^RCBEUBIL(RCBILLDA,DR)
. ;
. ; set date admin applied to account in file 340
. S DR=".12////"_RCUPDATE_";"
. S X=$$EDIT340^RCBEUDEB(+$P(^PRCA(430,RCBILLDA,0),"^",9),DR)
. ; clear the lock on the bill
. L -^PRCA(430,RCBILLDA)
. ;
. ; set tmp for mailman message, sort by date prepared
. S RCDATE=+$P(^PRCA(430,RCBILLDA,0),"^",10)
. S ^TMP("RCBECHGS REPORT",$J,RCDATE,RCBILLDA)=$P(RCDATA,"^")_"^"_$P(RCDATA,"^",2)_"^"_$P(RCDATA,"^",3)_"^"_RCTRANDA
Q
;
;
REPORT ; build report in mailman
N MMDATA,RCBILLDA,RCDATA,RCDATE,RCLINE,RCSPACE,RCTOTAL,RCUPDATE,X,XMDUN,XMY
K ^TMP($J,"RCRJRCORMM")
S RCSPACE=$J("",79)
S RCTOTAL=""
S RCLINE=2
S RCDATE="" F S RCDATE=$O(^TMP("RCBECHGS REPORT",$J,RCDATE)) Q:RCDATE="" D
. S RCBILLDA=0 F S RCBILLDA=$O(^TMP("RCBECHGS REPORT",$J,RCDATE,RCBILLDA)) Q:'RCBILLDA D
. . S RCDATA=^TMP("RCBECHGS REPORT",$J,RCDATE,RCBILLDA)
. . ; bill number
. . S MMDATA=$E($P($P($G(^PRCA(430,RCBILLDA,0)),"^"),"-",2)_RCSPACE,1,10)
. . ; date bill prepared
. . S MMDATA=MMDATA_$E($$FORMATDT^RCBECHGA(RCDATE)_RCSPACE,1,10)
. . ; transaction with charges added
. . S MMDATA=MMDATA_$E($P(RCDATA,"^",4)_RCSPACE,1,10)
. . ; date of update (transaction date)
. . S RCUPDATE=$P($G(^PRCA(433,+$P(RCDATA,"^",4),1)),"^")
. . S MMDATA=MMDATA_$E($$FORMATDT^RCBECHGA(RCUPDATE)_RCSPACE,1,10)
. . ; justify dollar amount 10 places with 2 decimal places,
. . ; if no interest, admin, penalty, then set to null
. . ; total dollars for end of report
. . F X=1:1:3 D
. . . S $P(RCTOTAL,"^",X)=$P(RCTOTAL,"^",X)+$P(RCDATA,"^",X)
. . . S $P(RCDATA,"^",X)=$S('$P(RCDATA,"^",X):$J("",12),1:$J($P(RCDATA,"^",X),12,2))
. . ; interest charge
. . S MMDATA=MMDATA_$P(RCDATA,"^",1)
. . ; admin charge
. . S MMDATA=MMDATA_$P(RCDATA,"^",2)
. . ; penalty charge
. . S MMDATA=MMDATA_$P(RCDATA,"^",3)
. . S RCLINE=RCLINE+1
. . S ^TMP($J,"RCRJRCORMM",RCLINE,0)=MMDATA
;
I RCLINE=2 S ^TMP($J,"RCRJRCORMM",1,0)="No interest, administrative, or penalty charges added on "_$$FMTE^XLFDT($$NOW^XLFDT)_"."
; if charges added, build header
I RCLINE'=2 D
. S ^TMP($J,"RCRJRCORMM",1,0)="BILL DATEPREP 433TRANS TRANDATE "_$J("INTEREST",12)_$J("ADMIN",12)_$J("PENALTY",12)
. S ^TMP($J,"RCRJRCORMM",2,0)="------ -------- -------- -------- "_$J("--------",12)_$J("-----",12)_$J("-------",12)
. ; build totals
. S RCLINE=RCLINE+1
. S ^TMP($J,"RCRJRCORMM",RCLINE,0)=$E(RCSPACE,1,42)_"---------- ---------- ----------"
. S RCLINE=RCLINE+1
. S ^TMP($J,"RCRJRCORMM",RCLINE,0)=$E(RCSPACE,1,30)_"TOTALS "_$J($P(RCTOTAL,"^"),12,2)_$J($P(RCTOTAL,"^",2),12,2)_$J($P(RCTOTAL,"^",3),12,2)
;
; send report
S XMY("G.PRCA ADJUSTMENT TRANS")=""
S X=$$SENDMSG^RCRJRCOR("AR Nightly Interest/Admin/Penalty Charges Added",.XMY)
K ^TMP($J,"RCRJRCORMM")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCBECHGU 5009 printed Dec 13, 2024@01:42:44 Page 2
RCBECHGU ;WISC/RFJ-process the charges to bill (called by rcbechgs) ;1 Jun 00
+1 ;;4.5;Accounts Receivable;**153**;Mar 20, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
ADDCHARG ; this is called by rcbechgs and is a continuation of that routine
+1 ; variables passed to this entry point:
+2 ; rcupdate = the fm date that charges are being added
+3 ; rcdata0 = debtor file entry 0th node
+4 ;
+5 NEW COMMENT,DR,RCBILLDA,RCDATA,RCDATE,RCLINE,RCTRANDA,RCTRDATE,VALUE,X
+6 ;
+7 ; for first party charges, the 433 transaction date must be 3 days
+8 ; prior to the statement date so the charges will appear on the
+9 ; patient statement (statement date is the variable rcupdate)
+10 SET RCTRDATE=RCUPDATE
+11 IF $PIECE(RCDATA0,"^")["DPT("
SET RCTRDATE=$$FMADD^XLFDT(RCUPDATE,-3)
+12 ;
+13 SET RCBILLDA=0
FOR
SET RCBILLDA=$ORDER(^TMP("RCBECHGS",$JOB,"ADDCHG",RCBILLDA))
if 'RCBILLDA
QUIT
Begin DoDot:1
+14 SET RCDATA=^TMP("RCBECHGS",$JOB,"ADDCHG",RCBILLDA)
+15 ; pass the value = interest ^ admin ^ penalty
+16 SET VALUE=+$PIECE(RCDATA,"^",1)_"^"_$PIECE(RCDATA,"^",2)_"^"_$PIECE(RCDATA,"^",3)
+17 ; no value for interest or admin
+18 IF '$PIECE(VALUE,"^")
IF '$PIECE(VALUE,"^",2)
IF '$PIECE(VALUE,"^",3)
QUIT
+19 ; pass the comments, admin comment (p4) and penalty comment (p5)
+20 SET COMMENT=""
SET RCLINE=1
+21 IF $PIECE(RCDATA,"^",4)'=""
SET COMMENT(RCLINE)="Admin Reason: "_$PIECE(RCDATA,"^",4)
SET RCLINE=2
+22 IF $PIECE(RCDATA,"^",5)'=""
SET COMMENT(RCLINE)="Penalty Reason: "_$PIECE(RCDATA,"^",5)
+23 ; lock the bill, this lock cannot fail
+24 LOCK +^PRCA(430,RCBILLDA)
+25 ;
+26 ; add the int/admin transaction
+27 SET RCTRANDA=$$INTADM^RCBEUTR1(RCBILLDA,VALUE,.COMMENT,RCTRDATE)
+28 IF 'RCTRANDA
LOCK -^PRCA(430,RCBILLDA)
QUIT
+29 ;
+30 ; set key fields in file 430
+31 SET DR=""
+32 ; interest last updated
+33 IF $PIECE(RCDATA,"^",1)
SET DR=DR_".11////"_RCUPDATE_";"
+34 ; admin last updated
+35 IF $PIECE(RCDATA,"^",2)
SET DR=DR_".12////"_RCUPDATE_";"
+36 ; penalty last updated
+37 IF $PIECE(RCDATA,"^",3)
SET DR=DR_".13////"_RCUPDATE_";"
+38 SET X=$$EDIT430^RCBEUBIL(RCBILLDA,DR)
+39 ;
+40 ; set date admin applied to account in file 340
+41 SET DR=".12////"_RCUPDATE_";"
+42 SET X=$$EDIT340^RCBEUDEB(+$PIECE(^PRCA(430,RCBILLDA,0),"^",9),DR)
+43 ; clear the lock on the bill
+44 LOCK -^PRCA(430,RCBILLDA)
+45 ;
+46 ; set tmp for mailman message, sort by date prepared
+47 SET RCDATE=+$PIECE(^PRCA(430,RCBILLDA,0),"^",10)
+48 SET ^TMP("RCBECHGS REPORT",$JOB,RCDATE,RCBILLDA)=$PIECE(RCDATA,"^")_"^"_$PIECE(RCDATA,"^",2)_"^"_$PIECE(RCDATA,"^",3)_"^"_RCTRANDA
End DoDot:1
+49 QUIT
+50 ;
+51 ;
REPORT ; build report in mailman
+1 NEW MMDATA,RCBILLDA,RCDATA,RCDATE,RCLINE,RCSPACE,RCTOTAL,RCUPDATE,X,XMDUN,XMY
+2 KILL ^TMP($JOB,"RCRJRCORMM")
+3 SET RCSPACE=$JUSTIFY("",79)
+4 SET RCTOTAL=""
+5 SET RCLINE=2
+6 SET RCDATE=""
FOR
SET RCDATE=$ORDER(^TMP("RCBECHGS REPORT",$JOB,RCDATE))
if RCDATE=""
QUIT
Begin DoDot:1
+7 SET RCBILLDA=0
FOR
SET RCBILLDA=$ORDER(^TMP("RCBECHGS REPORT",$JOB,RCDATE,RCBILLDA))
if 'RCBILLDA
QUIT
Begin DoDot:2
+8 SET RCDATA=^TMP("RCBECHGS REPORT",$JOB,RCDATE,RCBILLDA)
+9 ; bill number
+10 SET MMDATA=$EXTRACT($PIECE($PIECE($GET(^PRCA(430,RCBILLDA,0)),"^"),"-",2)_RCSPACE,1,10)
+11 ; date bill prepared
+12 SET MMDATA=MMDATA_$EXTRACT($$FORMATDT^RCBECHGA(RCDATE)_RCSPACE,1,10)
+13 ; transaction with charges added
+14 SET MMDATA=MMDATA_$EXTRACT($PIECE(RCDATA,"^",4)_RCSPACE,1,10)
+15 ; date of update (transaction date)
+16 SET RCUPDATE=$PIECE($GET(^PRCA(433,+$PIECE(RCDATA,"^",4),1)),"^")
+17 SET MMDATA=MMDATA_$EXTRACT($$FORMATDT^RCBECHGA(RCUPDATE)_RCSPACE,1,10)
+18 ; justify dollar amount 10 places with 2 decimal places,
+19 ; if no interest, admin, penalty, then set to null
+20 ; total dollars for end of report
+21 FOR X=1:1:3
Begin DoDot:3
+22 SET $PIECE(RCTOTAL,"^",X)=$PIECE(RCTOTAL,"^",X)+$PIECE(RCDATA,"^",X)
+23 SET $PIECE(RCDATA,"^",X)=$SELECT('$PIECE(RCDATA,"^",X):$JUSTIFY("",12),1:$JUSTIFY($PIECE(RCDATA,"^",X),12,2))
End DoDot:3
+24 ; interest charge
+25 SET MMDATA=MMDATA_$PIECE(RCDATA,"^",1)
+26 ; admin charge
+27 SET MMDATA=MMDATA_$PIECE(RCDATA,"^",2)
+28 ; penalty charge
+29 SET MMDATA=MMDATA_$PIECE(RCDATA,"^",3)
+30 SET RCLINE=RCLINE+1
+31 SET ^TMP($JOB,"RCRJRCORMM",RCLINE,0)=MMDATA
End DoDot:2
End DoDot:1
+32 ;
+33 IF RCLINE=2
SET ^TMP($JOB,"RCRJRCORMM",1,0)="No interest, administrative, or penalty charges added on "_$$FMTE^XLFDT($$NOW^XLFDT)_"."
+34 ; if charges added, build header
+35 IF RCLINE'=2
Begin DoDot:1
+36 SET ^TMP($JOB,"RCRJRCORMM",1,0)="BILL DATEPREP 433TRANS TRANDATE "_$JUSTIFY("INTEREST",12)_$JUSTIFY("ADMIN",12)_$JUSTIFY("PENALTY",12)
+37 SET ^TMP($JOB,"RCRJRCORMM",2,0)="------ -------- -------- -------- "_$JUSTIFY("--------",12)_$JUSTIFY("-----",12)_$JUSTIFY("-------",12)
+38 ; build totals
+39 SET RCLINE=RCLINE+1
+40 SET ^TMP($JOB,"RCRJRCORMM",RCLINE,0)=$EXTRACT(RCSPACE,1,42)_"---------- ---------- ----------"
+41 SET RCLINE=RCLINE+1
+42 SET ^TMP($JOB,"RCRJRCORMM",RCLINE,0)=$EXTRACT(RCSPACE,1,30)_"TOTALS "_$JUSTIFY($PIECE(RCTOTAL,"^"),12,2)_$JUSTIFY($PIECE(RCTOTAL,"^",2),12,2)_$JUSTIFY($PIECE(RCTOTAL,"^",3),12,2)
End DoDot:1
+43 ;
+44 ; send report
+45 SET XMY("G.PRCA ADJUSTMENT TRANS")=""
+46 SET X=$$SENDMSG^RCRJRCOR("AR Nightly Interest/Admin/Penalty Charges Added",.XMY)
+47 KILL ^TMP($JOB,"RCRJRCORMM")
+48 QUIT
