Routine: RCBECHGU

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.

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

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCBECHGU   5009     printed  Feb 18, 2025@23:09:07                                                                                                                                                                                                    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

RCBECHGU.m