Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCBEPAYF

RCBEPAYF.m

Go to the documentation of this file.
  1. RCBEPAYF ;WISC/RFJ-first party payment processing(called by rcbepay) ;1 Jun 00
  1. ;;4.5;Accounts Receivable;**153,301,322,315**;Mar 20, 1995;Build 67
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. Q
  1. ;
  1. ;PRCA*4.5*322 Awaken commented line to post payemnt to
  1. ; implied bill# for receipt payment
  1. ;
  1. FIRSTPTY() ; apply payment to first party account
  1. ; called by rcbepay
  1. N PAYMENT,RCBILBAL,RCBILLDA,RCDATE,RCDEBTDA,RCERROR,RCREPAMT,RCSTATUS,RCTRANDA,X,CSBILL,CSBILLDA,CSDEP,IDX,PREV
  1. K ^TMP("RCBEPAY",$J)
  1. ; acc't lookup info BB prca*4.5*301
  1. S CSBILLDA=+$E($P(RCDATA,"^",7),22,99),CSDEP=$P(RCDATA,"^",19),CSBILL=$E($P(RCDATA,"^",7),1,3)_"-"_$E($P(RCDATA,"^",7),4,10)
  1. I 'CSDEP S CSDEP=169 ;Default for missing pay type
  1. I $E($G(CSDEP),1,3)=170 S CSBILLDA=$O(^PRCA(430,"B",CSBILL,0))
  1. I RCDATA["PRCA(430," S CSBILLDA=+$P(RCDATA,"^",3)
  1. I CSDEP>167,CSDEP<171 S RCBETYPE=CSDEP
  1. ;end PRCA*4.5*301
  1. ;
  1. ; look up account in debtor file
  1. S RCDEBTDA=$$DEBT^RCEVUTL(RCACCT)
  1. I RCDEBTDA<0 Q "1^Could not add Patient ("_RCACCT_") to debtor file"
  1. ;
  1. ; lock the debtor account
  1. L +^RCD(340,RCDEBTDA):20 I '$T Q "1^Another user is working with this patient account"
  1. ;
  1. ; build list of active(16) and open(42) bills for patient
  1. ; sorted by date bill prepared
  1. F RCSTATUS=16,42 S RCBILLDA=0 F S RCBILLDA=$O(^PRCA(430,"AS",RCDEBTDA,RCSTATUS,RCBILLDA)) Q:'RCBILLDA D
  1. . ; check bill for prepayment
  1. . I $P(^PRCA(430,RCBILLDA,0),"^",2)=26 Q ; ACCOUNTS RECEIVABLE CATEGORY (PREPAYMENT=26)
  1. . ;
  1. . ; checks if payment was via a "170" CS Treasury lockbox transaction ; prca*4.5*301
  1. . ; Ignores bill if bill is NOT a "TCSP" CS bill
  1. . ; else sets as FIRST if designated as bill to be applied, or subsequent in oldest date order
  1. . I CSDEP=170 D Q ; prca*4.5*301
  1. . . I $D(^PRCA(430,"TCSP",RCBILLDA)) D Q ;
  1. . . . I CSBILLDA=RCBILLDA S ^TMP("RCBEPAY",$J,0,RCBILLDA)="" Q
  1. . . . S ^TMP("RCBEPAY",$J,880000000+$P($G(^PRCA(430,RCBILLDA,0)),"^",10),RCBILLDA)=""
  1. . . S ^TMP("RCBEPAY",$J,990000000+$P($G(^PRCA(430,RCBILLDA,0)),"^",10),RCBILLDA)=""
  1. . I $E($G(CSDEP),1,3)'=168,$D(^PRCA(430,"TCSP",RCBILLDA)) Q ;BB prca*4.5*301
  1. . I CSBILLDA=RCBILLDA S ^TMP("RCBEPAY",$J,0,RCBILLDA)="" Q ;PRCA*4.5*322
  1. . S ^TMP("RCBEPAY",$J,+$P($G(^PRCA(430,RCBILLDA,0)),"^",10),RCBILLDA)=""
  1. PROC ;
  1. ; loop all the bills for a patients account and keep looping them
  1. ; until either there is no more bills or the money paid is zero.
  1. ; the bills are looped in case of repayments. if there is money
  1. ; left over, this will apply more money to the repayment bills
  1. ; instead of creating a prepayment. a prepayment should only be
  1. ; created if all bills for the account is collected/closed.
  1. S RCERROR=0
  1. ; quit the loop if no money left to apply OR an error occurred OR
  1. ; no more bills left to apply payment to
  1. F D I 'RCPAYAMT!(RCERROR)!($O(^TMP("RCBEPAY",$J,""))="") Q
  1. . ; loop the bills by date prepared and apply the payment
  1. . ; quit if no money left to apply OR and error occurred
  1. . S RCDATE="" F S RCDATE=$O(^TMP("RCBEPAY",$J,RCDATE)) Q:RCDATE="" D I 'RCPAYAMT!(RCERROR) Q
  1. . . S RCBILLDA=0 F S RCBILLDA=$O(^TMP("RCBEPAY",$J,RCDATE,RCBILLDA)) Q:'RCBILLDA D I 'RCPAYAMT!(RCERROR) Q
  1. . . . L +^PRCA(430,RCBILLDA):10
  1. . . . I '$T S RCERROR="1^Another user is working with bill "_$P(^PRCA(430,RCBILLDA,0),"^") Q
  1. . . . ;
  1. . . . ; exempt any interest/admin/penalty charges added on or after
  1. . . . ; the payment date
  1. . . . D EXEMPT^RCBECHGE(RCBILLDA,RCPAYDAT)
  1. . . . ;
  1. . . . ; get the repayment amount (if any)
  1. . . . S RCREPAMT=$P($G(^PRCA(430,RCBILLDA,4)),"^",3) I CSDEP=168!(CSDEP=170) S RCREPAMT=0 ;PRCA*4.5*301
  1. . . . ;
  1. . . . ; get the balance of the bill
  1. . . . S X=$G(^PRCA(430,RCBILLDA,7))
  1. . . . S RCBILBAL=$P(X,"^")+$P(X,"^",2)+$P(X,"^",3)+$P(X,"^",4)+$P(X,"^",5)
  1. . . . ; if bill has no balance, chg status = collected/closed
  1. . . . I 'RCBILBAL D Q ;PRCA*4.5*301
  1. . . . . D CHGSTAT^RCBEUBIL(RCBILLDA,22)
  1. . . . . L -^PRCA(430,RCBILLDA)
  1. . . . . K ^TMP("RCBEPAY",$J,RCDATE,RCBILLDA)
  1. . . . ;
  1. . . . ; determine amount to pay
  1. . . . ; if the payment is greater than billed amount, pay billed amount
  1. . . . ; if there is a repayment amount, pay the repayment amount
  1. . . . ; do not allow payment to exceed amount paid
  1. . . . S PAYMENT=RCPAYAMT
  1. . . . I PAYMENT>RCBILBAL S PAYMENT=RCBILBAL
  1. . . . I RCREPAMT S PAYMENT=RCREPAMT I PAYMENT>RCBILBAL S PAYMENT=RCBILBAL
  1. . . . I PAYMENT>RCPAYAMT S PAYMENT=RCPAYAMT
  1. . . . ;
  1. . . . ; apply payment to bill
  1. . . . ; return error if problem adding payment transaction
  1. . . . S RCTRANDA=$$PAYTRAN^RCBEPAY1(RCBILLDA,PAYMENT,RCRECTDA,RCPAYDA,RCPAYDAT)
  1. . . . I 'RCTRANDA L -^PRCA(430,RCBILLDA) S RCERROR="1^"_$P(RCTRANDA,"^",2) Q
  1. . . . ;
  1. . . . ; payment applied to bill, subtract off the payment amount
  1. . . . S RCPAYAMT=RCPAYAMT-$P($G(^PRCA(433,RCTRANDA,1)),"^",5)
  1. . . . ;
  1. . . . ; set the amount processed on the receipt payment
  1. . . . D SETAMT^RCBEPAY(RCRECTDA,RCPAYDA,$P($G(^PRCA(433,RCTRANDA,1)),"^",5))
  1. . . . ;
  1. . . . ; if Bill is Cross-Serviced, then create DECREASED ADJUSTMENT for 5B reporting
  1. . . . I $E($G(CSDEP),1,3)=168,$D(^PRCA(430,"TCSP",RCBILLDA)) D CS5B(RCBILLDA) ; BB prca*4.5*301
  1. . . . I $E($G(CSDEP),1,3)=170,RCBILLDA'=CSBILLDA,$D(^PRCA(430,"TCSP",RCBILLDA)) D CS5B(RCBILLDA) ; BB prca*4.5*301
  1. . . . ;
  1. . . . ; get the new balance of the bill. if it is zero
  1. . . . ; remove it from the tmp global (this will stop the
  1. . . . ; loop if dollars are left and no bills are active)
  1. . . . S X=$G(^PRCA(430,RCBILLDA,7))
  1. . . . S RCBILBAL=$P(X,"^")+$P(X,"^",2)+$P(X,"^",3)+$P(X,"^",4)+$P(X,"^",5)
  1. . . . I 'RCBILBAL D ;PRCA*4.5*301
  1. . . . . D CHGSTAT^RCBEUBIL(RCBILLDA,22)
  1. . . . . K ^TMP("RCBEPAY",$J,RCDATE,RCBILLDA)
  1. . . . . I $D(^PRCA(430,"TCSP",RCBILLDA)),RCBILLDA=CSBILLDA S $P(^PRCA(430,RCBILLDA,15),"^")="" K ^PRCA(430,"TCSP",RCBILLDA) ;S DA=RCBILLDA,DIE="^PRCA(430,",DR="151////@" D ^DIE K DIE,DA,DR
  1. . . . ;
  1. . . . L -^PRCA(430,RCBILLDA)
  1. ;
  1. K ^TMP("RCBEPAY",$J)
  1. ;
  1. ; if an error occurred, quit
  1. I RCERROR L -^RCD(340,RCDEBTDA) Q RCERROR
  1. ;
  1. ; if no money left, quit
  1. I 'RCPAYAMT L -^RCD(340,RCDEBTDA) Q 0
  1. ;
  1. ; dollars remaining, create a prepayment
  1. N %,%H,%I,%X,D,D0,DFN,DI,DIC,DICR,DIG,DIH,DIU,DIV,DIW,DQ,I,PRCA,RCREF,VA,VADM
  1. D EN^PRCAPAY3(RCACCT,RCPAYAMT,RCPAYDAT,DUZ,$P(^RCY(344,RCRECTDA,0),"^"),"","",.RCERROR,"")
  1. ; no errors
  1. I RCERROR=""!(RCERROR=0) D
  1. . S RCERROR=0
  1. . ; set the amount processed on the receipt
  1. . D SETAMT^RCBEPAY(RCRECTDA,RCPAYDA,RCPAYAMT)
  1. ; error creating prepayment
  1. I RCERROR'=0 S RCERROR="1^"_RCERROR
  1. ;
  1. L -^RCD(340,RCDEBTDA)
  1. Q RCERROR
  1. ;
  1. CS5B(RCBILLDA) ; logs ADJ for 5B CS reporting if Cross-Serviced bill ; prca*4.5*301 ; LEG
  1. ; Changed description from DEC ADJ to ADJ since increase adjustments will also use this code 315/DRF
  1. ; note: can use either I +$G(^PRCA(430,RCBILLDA,15)) D ; bill is Cross-Serviced
  1. I $D(^PRCA(430,"TCSP",RCBILLDA)) D ; bill is Cross-Serviced
  1. . ; checks for valid bill
  1. . S DIC="^PRCA(430,",DIC(0)="KMNZ",X=RCBILLDA D ^DIC
  1. . ; checks if DEC ADJ record was previously logged
  1. . S IDX=0,PREV=0
  1. . F S IDX=$O(^PRCA(430,RCBILLDA,17,IDX)) Q:'IDX D ;
  1. . . I +$G(^PRCA(430,RCBILLDA,17,IDX,0))=RCTRANDA S PREV=1
  1. . I PREV Q ; transaction was already logged
  1. . ;
  1. . ; gets next ADJ subfile entry number or creates 1st
  1. . K DR,DA,DD,DO,DIC,DIE
  1. . S X=RCTRANDA ; CS ADJ TRANS NUMBER
  1. . S DA(1)=RCBILLDA
  1. . S DIC="^PRCA(430,"_DA(1)_",17,"
  1. . S DIC(0)="KLMNZ"
  1. . S DIC("P")=$P(^DD(430,171,0),"^",2)
  1. . D ^DIC
  1. . ; set ADJ Fields
  1. . S DIE=DIC K DIC
  1. . S DA=+Y
  1. . S DR="1////1" ; SEND TCSP RECORD 5B
  1. . S DIC("DR")=DR
  1. . D ^DIE
  1. Q