RCBDFST1 ;WISC/RFJ-patient statement utilities continued ;1 Dec 00
;;4.5;Accounts Receivable;**162**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
CHEKACCT(RCDEBTDA) ; check to see if a debtor is in balance
; returns null if in balance, or the calculated statement
; if out of balance
; returns rcbilbal,rcevent,rcnewact,rcstate,rclastev
; returns ^tmp("rcbdfst1",$j ... (see NEWTRANS below)
;
N %,DATA1,OUTOFBAL
; get the current balance of all active bills
D BILLBAL(RCDEBTDA)
; get the last statement, rclastev=ien file 341 ^ statement date
S RCLASTEV=$$LASTEVNT(RCDEBTDA)
I RCLASTEV L +^RC(341,+RCLASTEV)
; get the last statement balance
D EVENTBAL(+RCLASTEV)
; get new activity after the statement date
D NEWTRANS(RCDEBTDA,$P(RCLASTEV,"^",2),9999999)
; test for out of balance
; out of balance if the statement balance +/- new activity
; does not equal the current bill balance
S OUTOFBAL=""
F %="PB","IN","AD","MF","CC" D
. ; copy current statement to rcstate, rcstate used to track
. ; what the statement balance should be
. S RCSTATE(%)=RCEVENT(%)
. I RCEVENT(%)+RCNEWACT(%)=RCBILBAL(%) Q
. S OUTOFBAL=1
. S RCSTATE(%)=RCBILBAL(%)-RCNEWACT(%)
; compute calculated statement total
S RCSTATE=0
F %="PB","IN","AD","MF","CC" S RCSTATE=RCSTATE+RCSTATE(%)
;
I OUTOFBAL S OUTOFBAL=RCSTATE("PB")_"^"_RCSTATE("IN")_"^"_RCSTATE("AD")_"^"_RCSTATE("CC")_"^"_RCSTATE("MF")
;
L -^RC(341,+RCLASTEV)
Q OUTOFBAL
;
;
BILLBAL(DEBTDA) ; get the bill balances for a debtor
; returns array RCBILBAL("PB")=principal balance
; RCBILBAL("IN")=interest balance
; RCBILBAL("AD")=admin balance
; RCBILBAL("MF")=marshal fee balance
; RCBILBAL("CC")=court cost balance
; RCBILBAL =total balance
N %,BILLDA,DATA7,STATUS
; initialize
S RCBILBAL=0
F %="PB","IN","AD","MF","CC" S RCBILBAL(%)=0
;
; for active, open, and refund review (for prepayments),
; calc bill balance
F STATUS=16,42,44 S BILLDA=0 F S BILLDA=$O(^PRCA(430,"AS",DEBTDA,STATUS,BILLDA)) Q:'BILLDA D
. S DATA7=$P($G(^PRCA(430,BILLDA,7)),"^",1,5)
. ; if prepayment, subtract it from active bills principal balance
. I $P($G(^PRCA(430,BILLDA,0)),"^",2)=26 S RCBILBAL("PB")=RCBILBAL("PB")-$P(DATA7,"^") Q
. ; add balances
. S RCBILBAL("PB")=RCBILBAL("PB")+$P(DATA7,"^") ;principal
. S RCBILBAL("IN")=RCBILBAL("IN")+$P(DATA7,"^",2) ;interest
. S RCBILBAL("AD")=RCBILBAL("AD")+$P(DATA7,"^",3) ;admin
. S RCBILBAL("MF")=RCBILBAL("MF")+$P(DATA7,"^",4) ;marshal fee
. S RCBILBAL("CC")=RCBILBAL("CC")+$P(DATA7,"^",5) ;court cost
;
; compute total
F %="PB","IN","AD","MF","CC" S RCBILBAL=RCBILBAL+RCBILBAL(%)
Q
;
;
NEWTRANS(DEBTDA,BEGDATE,ENDDATE) ; get new transaction activity between dates
; returns global array
; tmp("rcbdfst1",$j,account,transactiondate,bill,transaction)=value
; where
; value = ^ prin ^ int ^ admin ^ mf ^ cc
;
N %,BILLDA,DATE,ORIGAMT,STATUS,TRANDA,VALUE
; initialize
S RCNEWACT=0
F %="PB","IN","AD","MF","CC" S RCNEWACT(%)=0
K ^TMP("RCBDFST1",$J,DEBTDA)
;
; get new bills
S DATE=BEGDATE F S DATE=$O(^PRCA(430,"ATD",DEBTDA,DATE)) Q:'DATE!(DATE>ENDDATE) D
. S BILLDA=0 F S BILLDA=$O(^PRCA(430,"ATD",DEBTDA,DATE,BILLDA)) Q:'BILLDA D
. . S ORIGAMT=$P($G(^PRCA(430,BILLDA,0)),"^",3)
. . S ^TMP("RCBDFST1",$J,DEBTDA,DATE,BILLDA,0)=ORIGAMT
. . S RCNEWACT("PB")=RCNEWACT("PB")+ORIGAMT
;
; get transactions
S DATE=BEGDATE F S DATE=$O(^PRCA(433,"ATD",DEBTDA,DATE)) Q:'DATE!(DATE>ENDDATE) D
. S TRANDA=0 F S TRANDA=$O(^PRCA(433,"ATD",DEBTDA,DATE,TRANDA)) Q:'TRANDA D
. . ; if not a valid transaction, do not include it
. . I '$$VALID^RCRJRCOT(TRANDA) Q
. . S BILLDA=+$P(^PRCA(433,TRANDA,0),"^",2)
. . ; get the transaction value
. . S VALUE=$$TRANVALU^RCDPBTLM(TRANDA)
. . ; transaction has no value
. . I $TR(VALUE,"^0")="" Q
. . ; for patient statements, if the bill is a prepayment(26),
. . ; change the sign
. . I $P($G(^PRCA(430,BILLDA,0)),"^",2)=26 F %=2:1:6 S $P(VALUE,"^",%)=-$P(VALUE,"^",%)
. . S ^TMP("RCBDFST1",$J,DEBTDA,DATE,BILLDA,TRANDA)=VALUE
. . S RCNEWACT("PB")=RCNEWACT("PB")+$P(VALUE,"^",2)
. . S RCNEWACT("IN")=RCNEWACT("IN")+$P(VALUE,"^",3)
. . S RCNEWACT("AD")=RCNEWACT("AD")+$P(VALUE,"^",4)
. . S RCNEWACT("MF")=RCNEWACT("MF")+$P(VALUE,"^",5)
. . S RCNEWACT("CC")=RCNEWACT("CC")+$P(VALUE,"^",6)
;
; compute total
F %="PB","IN","AD","MF","CC" S RCNEWACT=RCNEWACT+RCNEWACT(%)
Q
;
;
LASTEVNT(DEBTDA) ; get last type of event for debtor patient statement (2)
N EVENTDA,REVDATE,TYPEDA
; find the inverse date of the last statement, return 0 if none
S TYPEDA=+$O(^RC(341.1,"AC",2,0))
S REVDATE=+$O(^RC(341,"AD",DEBTDA,TYPEDA,0))
I 'REVDATE Q 0
; find the internal entry number of the statement
S EVENTDA=+$O(^RC(341,"AD",DEBTDA,TYPEDA,REVDATE,0))
; return the internal entry number ^ last statement date
Q EVENTDA_"^"_(9999999.999999-REVDATE)
;
;
EVENTBAL(EVENTDA) ; get the last statement balance
; returns array RCEVENT("PB")=principal balance
; RCEVENT("IN")=interest balance
; RCEVENT("AD")=admin balance
; RCEVENT("MF")=marshal fee balance
; RCEVENT("CC")=court cost balance
; RCEVENT =total balance
N %,DATA1
S DATA1=$G(^RC(341,EVENTDA,1))
S RCEVENT("PB")=$P(DATA1,"^",1) ;principal
S RCEVENT("IN")=$P(DATA1,"^",2) ;interest
S RCEVENT("AD")=$P(DATA1,"^",3) ;admin
S RCEVENT("CC")=$P(DATA1,"^",4) ;court cost
S RCEVENT("MF")=$P(DATA1,"^",5) ;marshal fee
; compute total
S RCEVENT=0
F %="PB","IN","AD","MF","CC" S RCEVENT=RCEVENT+RCEVENT(%)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCBDFST1 5989 printed Dec 13, 2024@01:42:31 Page 2
RCBDFST1 ;WISC/RFJ-patient statement utilities continued ;1 Dec 00
+1 ;;4.5;Accounts Receivable;**162**;Mar 20, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
CHEKACCT(RCDEBTDA) ; check to see if a debtor is in balance
+1 ; returns null if in balance, or the calculated statement
+2 ; if out of balance
+3 ; returns rcbilbal,rcevent,rcnewact,rcstate,rclastev
+4 ; returns ^tmp("rcbdfst1",$j ... (see NEWTRANS below)
+5 ;
+6 NEW %,DATA1,OUTOFBAL
+7 ; get the current balance of all active bills
+8 DO BILLBAL(RCDEBTDA)
+9 ; get the last statement, rclastev=ien file 341 ^ statement date
+10 SET RCLASTEV=$$LASTEVNT(RCDEBTDA)
+11 IF RCLASTEV
LOCK +^RC(341,+RCLASTEV)
+12 ; get the last statement balance
+13 DO EVENTBAL(+RCLASTEV)
+14 ; get new activity after the statement date
+15 DO NEWTRANS(RCDEBTDA,$PIECE(RCLASTEV,"^",2),9999999)
+16 ; test for out of balance
+17 ; out of balance if the statement balance +/- new activity
+18 ; does not equal the current bill balance
+19 SET OUTOFBAL=""
+20 FOR %="PB","IN","AD","MF","CC"
Begin DoDot:1
+21 ; copy current statement to rcstate, rcstate used to track
+22 ; what the statement balance should be
+23 SET RCSTATE(%)=RCEVENT(%)
+24 IF RCEVENT(%)+RCNEWACT(%)=RCBILBAL(%)
QUIT
+25 SET OUTOFBAL=1
+26 SET RCSTATE(%)=RCBILBAL(%)-RCNEWACT(%)
End DoDot:1
+27 ; compute calculated statement total
+28 SET RCSTATE=0
+29 FOR %="PB","IN","AD","MF","CC"
SET RCSTATE=RCSTATE+RCSTATE(%)
+30 ;
+31 IF OUTOFBAL
SET OUTOFBAL=RCSTATE("PB")_"^"_RCSTATE("IN")_"^"_RCSTATE("AD")_"^"_RCSTATE("CC")_"^"_RCSTATE("MF")
+32 ;
+33 LOCK -^RC(341,+RCLASTEV)
+34 QUIT OUTOFBAL
+35 ;
+36 ;
BILLBAL(DEBTDA) ; get the bill balances for a debtor
+1 ; returns array RCBILBAL("PB")=principal balance
+2 ; RCBILBAL("IN")=interest balance
+3 ; RCBILBAL("AD")=admin balance
+4 ; RCBILBAL("MF")=marshal fee balance
+5 ; RCBILBAL("CC")=court cost balance
+6 ; RCBILBAL =total balance
+7 NEW %,BILLDA,DATA7,STATUS
+8 ; initialize
+9 SET RCBILBAL=0
+10 FOR %="PB","IN","AD","MF","CC"
SET RCBILBAL(%)=0
+11 ;
+12 ; for active, open, and refund review (for prepayments),
+13 ; calc bill balance
+14 FOR STATUS=16,42,44
SET BILLDA=0
FOR
SET BILLDA=$ORDER(^PRCA(430,"AS",DEBTDA,STATUS,BILLDA))
if 'BILLDA
QUIT
Begin DoDot:1
+15 SET DATA7=$PIECE($GET(^PRCA(430,BILLDA,7)),"^",1,5)
+16 ; if prepayment, subtract it from active bills principal balance
+17 IF $PIECE($GET(^PRCA(430,BILLDA,0)),"^",2)=26
SET RCBILBAL("PB")=RCBILBAL("PB")-$PIECE(DATA7,"^")
QUIT
+18 ; add balances
+19 ;principal
SET RCBILBAL("PB")=RCBILBAL("PB")+$PIECE(DATA7,"^")
+20 ;interest
SET RCBILBAL("IN")=RCBILBAL("IN")+$PIECE(DATA7,"^",2)
+21 ;admin
SET RCBILBAL("AD")=RCBILBAL("AD")+$PIECE(DATA7,"^",3)
+22 ;marshal fee
SET RCBILBAL("MF")=RCBILBAL("MF")+$PIECE(DATA7,"^",4)
+23 ;court cost
SET RCBILBAL("CC")=RCBILBAL("CC")+$PIECE(DATA7,"^",5)
End DoDot:1
+24 ;
+25 ; compute total
+26 FOR %="PB","IN","AD","MF","CC"
SET RCBILBAL=RCBILBAL+RCBILBAL(%)
+27 QUIT
+28 ;
+29 ;
NEWTRANS(DEBTDA,BEGDATE,ENDDATE) ; get new transaction activity between dates
+1 ; returns global array
+2 ; tmp("rcbdfst1",$j,account,transactiondate,bill,transaction)=value
+3 ; where
+4 ; value = ^ prin ^ int ^ admin ^ mf ^ cc
+5 ;
+6 NEW %,BILLDA,DATE,ORIGAMT,STATUS,TRANDA,VALUE
+7 ; initialize
+8 SET RCNEWACT=0
+9 FOR %="PB","IN","AD","MF","CC"
SET RCNEWACT(%)=0
+10 KILL ^TMP("RCBDFST1",$JOB,DEBTDA)
+11 ;
+12 ; get new bills
+13 SET DATE=BEGDATE
FOR
SET DATE=$ORDER(^PRCA(430,"ATD",DEBTDA,DATE))
if 'DATE!(DATE>ENDDATE)
QUIT
Begin DoDot:1
+14 SET BILLDA=0
FOR
SET BILLDA=$ORDER(^PRCA(430,"ATD",DEBTDA,DATE,BILLDA))
if 'BILLDA
QUIT
Begin DoDot:2
+15 SET ORIGAMT=$PIECE($GET(^PRCA(430,BILLDA,0)),"^",3)
+16 SET ^TMP("RCBDFST1",$JOB,DEBTDA,DATE,BILLDA,0)=ORIGAMT
+17 SET RCNEWACT("PB")=RCNEWACT("PB")+ORIGAMT
End DoDot:2
End DoDot:1
+18 ;
+19 ; get transactions
+20 SET DATE=BEGDATE
FOR
SET DATE=$ORDER(^PRCA(433,"ATD",DEBTDA,DATE))
if 'DATE!(DATE>ENDDATE)
QUIT
Begin DoDot:1
+21 SET TRANDA=0
FOR
SET TRANDA=$ORDER(^PRCA(433,"ATD",DEBTDA,DATE,TRANDA))
if 'TRANDA
QUIT
Begin DoDot:2
+22 ; if not a valid transaction, do not include it
+23 IF '$$VALID^RCRJRCOT(TRANDA)
QUIT
+24 SET BILLDA=+$PIECE(^PRCA(433,TRANDA,0),"^",2)
+25 ; get the transaction value
+26 SET VALUE=$$TRANVALU^RCDPBTLM(TRANDA)
+27 ; transaction has no value
+28 IF $TRANSLATE(VALUE,"^0")=""
QUIT
+29 ; for patient statements, if the bill is a prepayment(26),
+30 ; change the sign
+31 IF $PIECE($GET(^PRCA(430,BILLDA,0)),"^",2)=26
FOR %=2:1:6
SET $PIECE(VALUE,"^",%)=-$PIECE(VALUE,"^",%)
+32 SET ^TMP("RCBDFST1",$JOB,DEBTDA,DATE,BILLDA,TRANDA)=VALUE
+33 SET RCNEWACT("PB")=RCNEWACT("PB")+$PIECE(VALUE,"^",2)
+34 SET RCNEWACT("IN")=RCNEWACT("IN")+$PIECE(VALUE,"^",3)
+35 SET RCNEWACT("AD")=RCNEWACT("AD")+$PIECE(VALUE,"^",4)
+36 SET RCNEWACT("MF")=RCNEWACT("MF")+$PIECE(VALUE,"^",5)
+37 SET RCNEWACT("CC")=RCNEWACT("CC")+$PIECE(VALUE,"^",6)
End DoDot:2
End DoDot:1
+38 ;
+39 ; compute total
+40 FOR %="PB","IN","AD","MF","CC"
SET RCNEWACT=RCNEWACT+RCNEWACT(%)
+41 QUIT
+42 ;
+43 ;
LASTEVNT(DEBTDA) ; get last type of event for debtor patient statement (2)
+1 NEW EVENTDA,REVDATE,TYPEDA
+2 ; find the inverse date of the last statement, return 0 if none
+3 SET TYPEDA=+$ORDER(^RC(341.1,"AC",2,0))
+4 SET REVDATE=+$ORDER(^RC(341,"AD",DEBTDA,TYPEDA,0))
+5 IF 'REVDATE
QUIT 0
+6 ; find the internal entry number of the statement
+7 SET EVENTDA=+$ORDER(^RC(341,"AD",DEBTDA,TYPEDA,REVDATE,0))
+8 ; return the internal entry number ^ last statement date
+9 QUIT EVENTDA_"^"_(9999999.999999-REVDATE)
+10 ;
+11 ;
EVENTBAL(EVENTDA) ; get the last statement balance
+1 ; returns array RCEVENT("PB")=principal balance
+2 ; RCEVENT("IN")=interest balance
+3 ; RCEVENT("AD")=admin balance
+4 ; RCEVENT("MF")=marshal fee balance
+5 ; RCEVENT("CC")=court cost balance
+6 ; RCEVENT =total balance
+7 NEW %,DATA1
+8 SET DATA1=$GET(^RC(341,EVENTDA,1))
+9 ;principal
SET RCEVENT("PB")=$PIECE(DATA1,"^",1)
+10 ;interest
SET RCEVENT("IN")=$PIECE(DATA1,"^",2)
+11 ;admin
SET RCEVENT("AD")=$PIECE(DATA1,"^",3)
+12 ;court cost
SET RCEVENT("CC")=$PIECE(DATA1,"^",4)
+13 ;marshal fee
SET RCEVENT("MF")=$PIECE(DATA1,"^",5)
+14 ; compute total
+15 SET RCEVENT=0
+16 FOR %="PB","IN","AD","MF","CC"
SET RCEVENT=RCEVENT+RCEVENT(%)
+17 QUIT
