RCDPXFIX ;WISC/RFJ -fix duplicate deposits (! be careful using this !) ;22 Mar 02
;;4.5;Accounts Receivable;**177,306**;Mar 20, 1995;Build 3
;;Per VA Directive 6402, this routine should not be modified.
;
; this routine is used to back out a duplicate deposit that has
; been posted to first party bills. do not use this routine
; unless instructed to by software design and development or
; national verification and support.
Q
;
;
REVERSE(RCDPOSIT,RCTRANDT) ; back out deposit RCDPOSIT
; RCDPOSIT is the deposit number, example 269296
; RCTRANDT is the transmission date, example 3001113
;
;
N %,RCBILLDA,RCDATA0,RCDPDT,RCFTEST,RCMESSAG,RCRCPT,RCTRAN1,RCTRANDA,X
K ^TMP("RCDPXFIX",$J)
;
; this is used for internal testing
;S RCFTEST=0 ; NO, do not make updates to the database
S RCFTEST=1 ; YES, make changes to the database
;
; **306 removing text that says "duplicate"
; set default message to send to user
;S RCMESSAG="Duplicate deposit "_RCDPOSIT_" with a transmission date of "_$E(RCTRANDT,4,5)_"/"_$E(RCTRANDT,6,7)_"/"_$E(RCTRANDT,2,3)_" was not found."
S RCMESSAG="Deposit "_RCDPOSIT_" with a transmission date of "_$E(RCTRANDT,4,5)_"/"_$E(RCTRANDT,6,7)_"/"_$E(RCTRANDT,2,3)_" was not found."
;
; find deposit which was posted erroneously, if no date then it is not found
S RCDPDT=$O(^RCY(344.1,"B",RCDPOSIT,0)) I 'RCDPDT D MAIL^RCDPXFIM(RCDPOSIT,RCTRANDT,RCMESSAG) Q
;
; find receipts for deposit
S RCRCPT=0 F S RCRCPT=$O(^RCY(344,"AD",RCDPDT,RCRCPT)) Q:'RCRCPT D
. S RCDATA0=$G(^RCY(344,RCRCPT,0))
. ; check to see if the date opened is equal to the transmission date
. I $P(RCDATA0,"^",3)'=RCTRANDT Q
. ;
. ; ** 306, removing "duplicate"
. ; deposit already backed out (the *end date is set once backed out)
. ;I $P(RCDATA0,"^",10) S RCMESSAG="Duplicate Deposit "_RCDPOSIT_" was previously backed out on "_$E($P(RCDATA0,"^",10),4,5)_"/"_$E($P(RCDATA0,"^",10),6,7)_"/"_$E($P(RCDATA0,"^",10),2,3)_"." Q
. I $P(RCDATA0,"^",10) S RCMESSAG="Deposit "_RCDPOSIT_" was previously backed out on "_$E($P(RCDATA0,"^",10),4,5)_"/"_$E($P(RCDATA0,"^",10),6,7)_"/"_$E($P(RCDATA0,"^",10),2,3)_"." Q
. ;
. ; found deposit/receipt and it needs to be backed out
. ;S RCMESSAG="Duplicate deposit "_RCDPOSIT_" with a transmission date of "_$E(RCTRANDT,4,5)_"/"_$E(RCTRANDT,6,7)_"/"_$E(RCTRANDT,2,3)_" has been removed."
. S RCMESSAG="Deposit "_RCDPOSIT_" with a transmission date of "_$E(RCTRANDT,4,5)_"/"_$E(RCTRANDT,6,7)_"/"_$E(RCTRANDT,2,3)_" has been removed."
. ;
. ; loop payments made in transaction 433 file
. S RCTRANDA=0 F S RCTRANDA=$O(^PRCA(433,"AF",$P(RCDATA0,"^"),RCTRANDA)) Q:'RCTRANDA D
. . ; transaction is already marked incomplete
. . I $P(^PRCA(433,RCTRANDA,0),"^",4)=1 Q
. . ;
. . ; lock the transaction
. . L +^PRCA(433,RCTRANDA)
. . ;
. . ; get transaction data
. . S RCTRAN1=$G(^PRCA(433,RCTRANDA,1))
. . S RCBILLDA=$P(^PRCA(433,RCTRANDA,0),"^",2)
. . ;
. . ; lock the bill
. . L +^PRCA(430,RCBILLDA)
. . ;
. . ;
. . ; transaction type = payment in part (2) or
. . ; transaction type = payment in full (34)
. . I $P(RCTRAN1,"^",2)=2!($P(RCTRAN1,"^",2)=34) D PAYMENT(RCTRANDA,1)
. . ;
. . ;
. . ; transaction type = prepayment [increase adjustment (1)]
. . I $P(RCTRAN1,"^",2)=1 D PREPAY
. . ;
. . ; unlock the bill and transaction
. . L -^PRCA(430,RCBILLDA)
. . L -^PRCA(433,RCTRANDA)
. ;
. ; make changes to the payments on the receipt
. D RECEIPT(RCDPOSIT,RCTRANDT,RCRCPT)
. ;
. ; set piece 10 in receipt to show patch as being installed
. I RCFTEST D NOW^%DTC S $P(^RCY(344,RCRCPT,0),"^",10)=%
;
D MAIL^RCDPXFIM(RCDPOSIT,RCTRANDT,RCMESSAG)
;
K ^TMP("RCDPXFIX",$J)
Q
;
;
PAYMENT(RCTRANDA,RCFREPRT) ; mark payment transaction as incomplete and adjust bill
; pass rcfrept equal to 1 to build mailman report. since prepayment
; payments to other bills are already printed on report, pass a zero
; to stop the setting of the tmp global
;
N %,DATA0,FYDA,PIECE,RCBILLDA,RCBILL7,RCCOMMNT,RCREPDA,RCTRAN3
; amount paid
S RCTRAN3=$G(^PRCA(433,RCTRANDA,3))
; get the bill
S RCBILLDA=$P($G(^PRCA(433,RCTRANDA,0)),"^",2)
;
; reset the 7 node on the bill
S RCBILL7=$G(^PRCA(430,RCBILLDA,7))
F PIECE=1:1:5 D
. ; add the payment back to the bills balance
. S $P(RCBILL7,"^",PIECE)=$P(RCBILL7,"^",PIECE)+$P(RCTRAN3,"^",PIECE)
. ; subtract the payment made for the bill
. S $P(RCBILL7,"^",PIECE+6)=$P(RCBILL7,"^",PIECE+6)-$P(RCTRAN3,"^",PIECE)
. I RCFTEST S ^PRCA(430,RCBILLDA,7)=RCBILL7
;
; make sure the bill is active (16) if collected/closed (22)
I $P(^PRCA(430,RCBILLDA,0),"^",8)=22 I RCFTEST S %=$$EDIT430^RCBEUBIL(RCBILLDA,"8////16;")
;
; reset the fiscal year multiple
S FYDA=$O(^PRCA(430,RCBILLDA,2,999),-1)
I $G(^PRCA(430,RCBILLDA,2,+FYDA,0))'="" I RCFTEST S $P(^PRCA(430,RCBILLDA,2,FYDA,0),"^",2)=$P(RCBILL7,"^")
;
; remove repayment plans
S RCREPDA=0 F S RCREPDA=$O(^PRCA(430,RCBILLDA,5,RCREPDA)) Q:'RCREPDA D
. S DATA0=$G(^PRCA(430,RCBILLDA,5,RCREPDA,0))
. I $P(DATA0,"^",4)'=RCTRANDA Q
. ; found one, remove it
. I RCFTEST S ^PRCA(430,RCBILLDA,5,RCREPDA,0)=$P(DATA0,"^")_"^0"
;
; set the payment transaction to incomplete
I RCFTEST S $P(^PRCA(433,RCTRANDA,0),"^",4)=1
;
; **306, removing "dupicate"
; add comment to transaction
;S RCCOMMNT(1)="Duplicate deposit "_RCDPOSIT_" with transmission date "_$E(RCTRANDT,4,5)_"/"_$E(RCTRANDT,6,7)_"/"_$E(RCTRANDT,2,3)_" removed."
S RCCOMMNT(1)="Deposit "_RCDPOSIT_" with transmission date "_$E(RCTRANDT,4,5)_"/"_$E(RCTRANDT,6,7)_"/"_$E(RCTRANDT,2,3)_" removed."
I RCFTEST D ADDCOMM^RCBEUTRA(RCTRANDA,.RCCOMMNT)
;
; build mailman message
I RCFREPRT S ^TMP("RCDPXFIX",$J,RCBILLDA,RCTRANDA)=""
Q
;
;
PREPAY ; fix a prepayment
; at entry point, rctranda is the increase adjustment to rcbillda
;
N RCBILL7,RCDECADJ,RCPAYAMT,PAYTRAN
S RCBILL7=$G(^PRCA(430,RCBILLDA,7))
;
; simple, prepayment has not been used against another bill:
; get rid of the increase adjustment
I $P(RCBILL7,"^")'<$P($G(^PRCA(433,RCTRANDA,1)),"^",5) D PREPAYAD(RCTRANDA) Q
;
; prepayment has been used against other bills:
; get rid of the payments to other bills
; get rid of the decrease adjustments to prepayment bill
; get rid of the increase adjustment to prepayment bill
S RCPAYAMT=$P($G(^PRCA(433,RCTRANDA,1)),"^",5)
S RCDECADJ=RCTRANDA F S RCDECADJ=$O(^PRCA(433,"C",RCBILLDA,RCDECADJ)) Q:'RCDECADJ D I 'RCPAYAMT Q
. ; not a decrease adjustment
. I $P($G(^PRCA(433,RCDECADJ,1)),"^",2)'=35 Q
. ;
. ; lock the decrease adjustment
. L +^PRCA(433,RCDECADJ)
. ;
. ; get the payment transaction (433) that goes with decrease
. ; to prepayment bill
. S PAYTRAN=$P($G(^PRCA(433,RCDECADJ,5)),"^",1)
. ;
. ; lock the payment transaction
. L +^PRCA(433,PAYTRAN)
. ;
. ; get rid of the payment transaction, activate bill
. ; pass a zero so it does not show on mailman report twice
. I PAYTRAN D PAYMENT(PAYTRAN,0)
. ;
. ; get rid of decrease adjustment
. D PREPAYAD(RCDECADJ)
. ;
. ; subtract the decrease adjustment from the payment amount
. ; do this till it reaches zero
. S RCPAYAMT=RCPAYAMT-$P($G(^PRCA(433,RCDECADJ,1)),"^",5)
. ;
. ; unlock
. L -^PRCA(433,PAYTRAN)
. L -^PRCA(433,RCDECADJ)
;
; get rid of the increase adjustment to the prepayment bill
D PREPAYAD(RCTRANDA)
Q
;
;
PREPAYAD(RCTRANDA) ; get rid of a transaction on a prepayment bill
N FYDA,RCBILL7,RCCOMMNT,RCTRAN1
S RCTRAN1=$G(^PRCA(433,RCTRANDA,1))
S RCBILL7=$G(^PRCA(430,RCBILLDA,7))
;
; reset the 7 node on the bill
; increase: subtract the payment from the bills principal balance
I $P(RCTRAN1,"^",2)=1 S $P(RCBILL7,"^")=$P(RCBILL7,"^")-$P(RCTRAN1,"^",5)
; decrease: add the payment from the bills principal balance
I $P(RCTRAN1,"^",2)=35 S $P(RCBILL7,"^")=$P(RCBILL7,"^")+$P(RCTRAN1,"^",5)
I RCFTEST S ^PRCA(430,RCBILLDA,7)=RCBILL7
;
; reset the fiscal year multiple
S FYDA=$O(^PRCA(430,RCBILLDA,2,999),-1)
I $G(^PRCA(430,RCBILLDA,2,+FYDA,0))'="" I RCFTEST S $P(^PRCA(430,RCBILLDA,2,FYDA,0),"^",2)=$P(RCBILL7,"^")
;
; if the bills balance is zero, cancel it
I '$P(RCBILL7,"^") I RCFTEST S %=$$EDIT430^RCBEUBIL(RCBILLDA,"8////39;")
;
; set the payment transaction to incomplete
I RCFTEST S $P(^PRCA(433,RCTRANDA,0),"^",4)=1
;
; **306, removing "duplicate" to make more generic
; add comment to transaction
;S RCCOMMNT(1)="Duplicate deposit "_RCDPOSIT_" with transmission date "_$E(RCTRANDT,4,5)_"/"_$E(RCTRANDT,6,7)_"/"_$E(RCTRANDT,2,3)_" removed."
S RCCOMMNT(1)="Deposit "_RCDPOSIT_" with transmission date "_$E(RCTRANDT,4,5)_"/"_$E(RCTRANDT,6,7)_"/"_$E(RCTRANDT,2,3)_" removed."
I RCFTEST D ADDCOMM^RCBEUTRA(RCTRANDA,.RCCOMMNT)
;
; build for mailman report
S ^TMP("RCDPXFIX",$J,RCBILLDA,RCTRANDA)=""
Q
;
;
RECEIPT(RCDPOSIT,RCTRANDT,RCRCPT) ; make changes to receipt file
N RCACCT,RCBILLDA,RCDEBTDA,RCPAYDA
S RCPAYDA=0 F S RCPAYDA=$O(^RCY(344,RCRCPT,1,RCPAYDA)) Q:'RCPAYDA D
. ; add comment to payment in receipt file
. ;**306, removing "duplicate"
. ;I RCFTEST S $P(^RCY(344,RCRCPT,1,RCPAYDA,1),"^",2)="Duplicate deposit "_RCDPOSIT_" with transmission date "_$E(RCTRANDT,4,5)_"/"_$E(RCTRANDT,6,7)_"/"_$E(RCTRANDT,2,3)_" removed."
. I RCFTEST S $P(^RCY(344,RCRCPT,1,RCPAYDA,1),"^",2)="Deposit "_RCDPOSIT_" with transmission date "_$E(RCTRANDT,4,5)_"/"_$E(RCTRANDT,6,7)_"/"_$E(RCTRANDT,2,3)_" removed."
. ;
. ; if the account is missing on the payment, then zero out the dollar amount
. ; to prevent it from showing as an unlinked payment
. S RCACCT=$P(^RCY(344,RCRCPT,1,RCPAYDA,0),"^",3)
. I 'RCACCT S:RCFTEST $P(^RCY(344,RCRCPT,1,RCPAYDA,0),"^",4)=0 Q
. ;
. ; check acct to see if it has prepayments open with active bills. if so,
. ; apply the prepayment to the active bill
. S RCDEBTDA=$O(^RCD(340,"B",RCACCT,0)) I 'RCDEBTDA Q
. ;
. ; no prepayments for account
. I '$O(^PRCA(430,"AS",RCDEBTDA,42,0)) Q
. ;
. ; no active bills for account
. I '$O(^PRCA(430,"AS",RCDEBTDA,16,0)) Q
. ;
. ; loop active (16) bills for debtor and apply prepayment
. S RCBILLDA=0 F S RCBILLDA=$O(^PRCA(430,"AS",RCDEBTDA,16,RCBILLDA)) Q:'RCBILLDA D
. . ; no prepayments left, stop loop
. . I '$O(^PRCA(430,"AS",RCDEBTDA,42,0)) S RCBILLDA="A" Q
. . ;
. . ; this line is for testing
. . I 'RCFTEST W !,"Prepayment being applied to bill ",RCBILLDA Q
. . D PREPAY^RCBEPAYP(RCBILLDA,0)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPXFIX 10942 printed Apr 09, 2024@20:49:04 Page 2
RCDPXFIX ;WISC/RFJ -fix duplicate deposits (! be careful using this !) ;22 Mar 02
+1 ;;4.5;Accounts Receivable;**177,306**;Mar 20, 1995;Build 3
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; this routine is used to back out a duplicate deposit that has
+5 ; been posted to first party bills. do not use this routine
+6 ; unless instructed to by software design and development or
+7 ; national verification and support.
+8 QUIT
+9 ;
+10 ;
REVERSE(RCDPOSIT,RCTRANDT) ; back out deposit RCDPOSIT
+1 ; RCDPOSIT is the deposit number, example 269296
+2 ; RCTRANDT is the transmission date, example 3001113
+3 ;
+4 ;
+5 NEW %,RCBILLDA,RCDATA0,RCDPDT,RCFTEST,RCMESSAG,RCRCPT,RCTRAN1,RCTRANDA,X
+6 KILL ^TMP("RCDPXFIX",$JOB)
+7 ;
+8 ; this is used for internal testing
+9 ;S RCFTEST=0 ; NO, do not make updates to the database
+10 ; YES, make changes to the database
SET RCFTEST=1
+11 ;
+12 ; **306 removing text that says "duplicate"
+13 ; set default message to send to user
+14 ;S RCMESSAG="Duplicate deposit "_RCDPOSIT_" with a transmission date of "_$E(RCTRANDT,4,5)_"/"_$E(RCTRANDT,6,7)_"/"_$E(RCTRANDT,2,3)_" was not found."
+15 SET RCMESSAG="Deposit "_RCDPOSIT_" with a transmission date of "_$EXTRACT(RCTRANDT,4,5)_"/"_$EXTRACT(RCTRANDT,6,7)_"/"_$EXTRACT(RCTRANDT,2,3)_" was not found."
+16 ;
+17 ; find deposit which was posted erroneously, if no date then it is not found
+18 SET RCDPDT=$ORDER(^RCY(344.1,"B",RCDPOSIT,0))
IF 'RCDPDT
DO MAIL^RCDPXFIM(RCDPOSIT,RCTRANDT,RCMESSAG)
QUIT
+19 ;
+20 ; find receipts for deposit
+21 SET RCRCPT=0
FOR
SET RCRCPT=$ORDER(^RCY(344,"AD",RCDPDT,RCRCPT))
if 'RCRCPT
QUIT
Begin DoDot:1
+22 SET RCDATA0=$GET(^RCY(344,RCRCPT,0))
+23 ; check to see if the date opened is equal to the transmission date
+24 IF $PIECE(RCDATA0,"^",3)'=RCTRANDT
QUIT
+25 ;
+26 ; ** 306, removing "duplicate"
+27 ; deposit already backed out (the *end date is set once backed out)
+28 ;I $P(RCDATA0,"^",10) S RCMESSAG="Duplicate Deposit "_RCDPOSIT_" was previously backed out on "_$E($P(RCDATA0,"^",10),4,5)_"/"_$E($P(RCDATA0,"^",10),6,7)_"/"_$E($P(RCDATA0,"^",10),2,3)_"." Q
+29 IF $PIECE(RCDATA0,"^",10)
SET RCMESSAG="Deposit "_RCDPOSIT_" was previously backed out on "_$EXTRACT($PIECE(RCDATA0,"^",10),4,5)_"/"_$EXTRACT($PIECE(RCDATA0,"^",10),6,7)_"/"_$EXTRACT($PIECE(RCDATA0,"^",10),2,3)_"."
QUIT
+30 ;
+31 ; found deposit/receipt and it needs to be backed out
+32 ;S RCMESSAG="Duplicate deposit "_RCDPOSIT_" with a transmission date of "_$E(RCTRANDT,4,5)_"/"_$E(RCTRANDT,6,7)_"/"_$E(RCTRANDT,2,3)_" has been removed."
+33 SET RCMESSAG="Deposit "_RCDPOSIT_" with a transmission date of "_$EXTRACT(RCTRANDT,4,5)_"/"_$EXTRACT(RCTRANDT,6,7)_"/"_$EXTRACT(RCTRANDT,2,3)_" has been removed."
+34 ;
+35 ; loop payments made in transaction 433 file
+36 SET RCTRANDA=0
FOR
SET RCTRANDA=$ORDER(^PRCA(433,"AF",$PIECE(RCDATA0,"^"),RCTRANDA))
if 'RCTRANDA
QUIT
Begin DoDot:2
+37 ; transaction is already marked incomplete
+38 IF $PIECE(^PRCA(433,RCTRANDA,0),"^",4)=1
QUIT
+39 ;
+40 ; lock the transaction
+41 LOCK +^PRCA(433,RCTRANDA)
+42 ;
+43 ; get transaction data
+44 SET RCTRAN1=$GET(^PRCA(433,RCTRANDA,1))
+45 SET RCBILLDA=$PIECE(^PRCA(433,RCTRANDA,0),"^",2)
+46 ;
+47 ; lock the bill
+48 LOCK +^PRCA(430,RCBILLDA)
+49 ;
+50 ;
+51 ; transaction type = payment in part (2) or
+52 ; transaction type = payment in full (34)
+53 IF $PIECE(RCTRAN1,"^",2)=2!($PIECE(RCTRAN1,"^",2)=34)
DO PAYMENT(RCTRANDA,1)
+54 ;
+55 ;
+56 ; transaction type = prepayment [increase adjustment (1)]
+57 IF $PIECE(RCTRAN1,"^",2)=1
DO PREPAY
+58 ;
+59 ; unlock the bill and transaction
+60 LOCK -^PRCA(430,RCBILLDA)
+61 LOCK -^PRCA(433,RCTRANDA)
End DoDot:2
+62 ;
+63 ; make changes to the payments on the receipt
+64 DO RECEIPT(RCDPOSIT,RCTRANDT,RCRCPT)
+65 ;
+66 ; set piece 10 in receipt to show patch as being installed
+67 IF RCFTEST
DO NOW^%DTC
SET $PIECE(^RCY(344,RCRCPT,0),"^",10)=%
End DoDot:1
+68 ;
+69 DO MAIL^RCDPXFIM(RCDPOSIT,RCTRANDT,RCMESSAG)
+70 ;
+71 KILL ^TMP("RCDPXFIX",$JOB)
+72 QUIT
+73 ;
+74 ;
PAYMENT(RCTRANDA,RCFREPRT) ; mark payment transaction as incomplete and adjust bill
+1 ; pass rcfrept equal to 1 to build mailman report. since prepayment
+2 ; payments to other bills are already printed on report, pass a zero
+3 ; to stop the setting of the tmp global
+4 ;
+5 NEW %,DATA0,FYDA,PIECE,RCBILLDA,RCBILL7,RCCOMMNT,RCREPDA,RCTRAN3
+6 ; amount paid
+7 SET RCTRAN3=$GET(^PRCA(433,RCTRANDA,3))
+8 ; get the bill
+9 SET RCBILLDA=$PIECE($GET(^PRCA(433,RCTRANDA,0)),"^",2)
+10 ;
+11 ; reset the 7 node on the bill
+12 SET RCBILL7=$GET(^PRCA(430,RCBILLDA,7))
+13 FOR PIECE=1:1:5
Begin DoDot:1
+14 ; add the payment back to the bills balance
+15 SET $PIECE(RCBILL7,"^",PIECE)=$PIECE(RCBILL7,"^",PIECE)+$PIECE(RCTRAN3,"^",PIECE)
+16 ; subtract the payment made for the bill
+17 SET $PIECE(RCBILL7,"^",PIECE+6)=$PIECE(RCBILL7,"^",PIECE+6)-$PIECE(RCTRAN3,"^",PIECE)
+18 IF RCFTEST
SET ^PRCA(430,RCBILLDA,7)=RCBILL7
End DoDot:1
+19 ;
+20 ; make sure the bill is active (16) if collected/closed (22)
+21 IF $PIECE(^PRCA(430,RCBILLDA,0),"^",8)=22
IF RCFTEST
SET %=$$EDIT430^RCBEUBIL(RCBILLDA,"8////16;")
+22 ;
+23 ; reset the fiscal year multiple
+24 SET FYDA=$ORDER(^PRCA(430,RCBILLDA,2,999),-1)
+25 IF $GET(^PRCA(430,RCBILLDA,2,+FYDA,0))'=""
IF RCFTEST
SET $PIECE(^PRCA(430,RCBILLDA,2,FYDA,0),"^",2)=$PIECE(RCBILL7,"^")
+26 ;
+27 ; remove repayment plans
+28 SET RCREPDA=0
FOR
SET RCREPDA=$ORDER(^PRCA(430,RCBILLDA,5,RCREPDA))
if 'RCREPDA
QUIT
Begin DoDot:1
+29 SET DATA0=$GET(^PRCA(430,RCBILLDA,5,RCREPDA,0))
+30 IF $PIECE(DATA0,"^",4)'=RCTRANDA
QUIT
+31 ; found one, remove it
+32 IF RCFTEST
SET ^PRCA(430,RCBILLDA,5,RCREPDA,0)=$PIECE(DATA0,"^")_"^0"
End DoDot:1
+33 ;
+34 ; set the payment transaction to incomplete
+35 IF RCFTEST
SET $PIECE(^PRCA(433,RCTRANDA,0),"^",4)=1
+36 ;
+37 ; **306, removing "dupicate"
+38 ; add comment to transaction
+39 ;S RCCOMMNT(1)="Duplicate deposit "_RCDPOSIT_" with transmission date "_$E(RCTRANDT,4,5)_"/"_$E(RCTRANDT,6,7)_"/"_$E(RCTRANDT,2,3)_" removed."
+40 SET RCCOMMNT(1)="Deposit "_RCDPOSIT_" with transmission date "_$EXTRACT(RCTRANDT,4,5)_"/"_$EXTRACT(RCTRANDT,6,7)_"/"_$EXTRACT(RCTRANDT,2,3)_" removed."
+41 IF RCFTEST
DO ADDCOMM^RCBEUTRA(RCTRANDA,.RCCOMMNT)
+42 ;
+43 ; build mailman message
+44 IF RCFREPRT
SET ^TMP("RCDPXFIX",$JOB,RCBILLDA,RCTRANDA)=""
+45 QUIT
+46 ;
+47 ;
PREPAY ; fix a prepayment
+1 ; at entry point, rctranda is the increase adjustment to rcbillda
+2 ;
+3 NEW RCBILL7,RCDECADJ,RCPAYAMT,PAYTRAN
+4 SET RCBILL7=$GET(^PRCA(430,RCBILLDA,7))
+5 ;
+6 ; simple, prepayment has not been used against another bill:
+7 ; get rid of the increase adjustment
+8 IF $PIECE(RCBILL7,"^")'<$PIECE($GET(^PRCA(433,RCTRANDA,1)),"^",5)
DO PREPAYAD(RCTRANDA)
QUIT
+9 ;
+10 ; prepayment has been used against other bills:
+11 ; get rid of the payments to other bills
+12 ; get rid of the decrease adjustments to prepayment bill
+13 ; get rid of the increase adjustment to prepayment bill
+14 SET RCPAYAMT=$PIECE($GET(^PRCA(433,RCTRANDA,1)),"^",5)
+15 SET RCDECADJ=RCTRANDA
FOR
SET RCDECADJ=$ORDER(^PRCA(433,"C",RCBILLDA,RCDECADJ))
if 'RCDECADJ
QUIT
Begin DoDot:1
+16 ; not a decrease adjustment
+17 IF $PIECE($GET(^PRCA(433,RCDECADJ,1)),"^",2)'=35
QUIT
+18 ;
+19 ; lock the decrease adjustment
+20 LOCK +^PRCA(433,RCDECADJ)
+21 ;
+22 ; get the payment transaction (433) that goes with decrease
+23 ; to prepayment bill
+24 SET PAYTRAN=$PIECE($GET(^PRCA(433,RCDECADJ,5)),"^",1)
+25 ;
+26 ; lock the payment transaction
+27 LOCK +^PRCA(433,PAYTRAN)
+28 ;
+29 ; get rid of the payment transaction, activate bill
+30 ; pass a zero so it does not show on mailman report twice
+31 IF PAYTRAN
DO PAYMENT(PAYTRAN,0)
+32 ;
+33 ; get rid of decrease adjustment
+34 DO PREPAYAD(RCDECADJ)
+35 ;
+36 ; subtract the decrease adjustment from the payment amount
+37 ; do this till it reaches zero
+38 SET RCPAYAMT=RCPAYAMT-$PIECE($GET(^PRCA(433,RCDECADJ,1)),"^",5)
+39 ;
+40 ; unlock
+41 LOCK -^PRCA(433,PAYTRAN)
+42 LOCK -^PRCA(433,RCDECADJ)
End DoDot:1
IF 'RCPAYAMT
QUIT
+43 ;
+44 ; get rid of the increase adjustment to the prepayment bill
+45 DO PREPAYAD(RCTRANDA)
+46 QUIT
+47 ;
+48 ;
PREPAYAD(RCTRANDA) ; get rid of a transaction on a prepayment bill
+1 NEW FYDA,RCBILL7,RCCOMMNT,RCTRAN1
+2 SET RCTRAN1=$GET(^PRCA(433,RCTRANDA,1))
+3 SET RCBILL7=$GET(^PRCA(430,RCBILLDA,7))
+4 ;
+5 ; reset the 7 node on the bill
+6 ; increase: subtract the payment from the bills principal balance
+7 IF $PIECE(RCTRAN1,"^",2)=1
SET $PIECE(RCBILL7,"^")=$PIECE(RCBILL7,"^")-$PIECE(RCTRAN1,"^",5)
+8 ; decrease: add the payment from the bills principal balance
+9 IF $PIECE(RCTRAN1,"^",2)=35
SET $PIECE(RCBILL7,"^")=$PIECE(RCBILL7,"^")+$PIECE(RCTRAN1,"^",5)
+10 IF RCFTEST
SET ^PRCA(430,RCBILLDA,7)=RCBILL7
+11 ;
+12 ; reset the fiscal year multiple
+13 SET FYDA=$ORDER(^PRCA(430,RCBILLDA,2,999),-1)
+14 IF $GET(^PRCA(430,RCBILLDA,2,+FYDA,0))'=""
IF RCFTEST
SET $PIECE(^PRCA(430,RCBILLDA,2,FYDA,0),"^",2)=$PIECE(RCBILL7,"^")
+15 ;
+16 ; if the bills balance is zero, cancel it
+17 IF '$PIECE(RCBILL7,"^")
IF RCFTEST
SET %=$$EDIT430^RCBEUBIL(RCBILLDA,"8////39;")
+18 ;
+19 ; set the payment transaction to incomplete
+20 IF RCFTEST
SET $PIECE(^PRCA(433,RCTRANDA,0),"^",4)=1
+21 ;
+22 ; **306, removing "duplicate" to make more generic
+23 ; add comment to transaction
+24 ;S RCCOMMNT(1)="Duplicate deposit "_RCDPOSIT_" with transmission date "_$E(RCTRANDT,4,5)_"/"_$E(RCTRANDT,6,7)_"/"_$E(RCTRANDT,2,3)_" removed."
+25 SET RCCOMMNT(1)="Deposit "_RCDPOSIT_" with transmission date "_$EXTRACT(RCTRANDT,4,5)_"/"_$EXTRACT(RCTRANDT,6,7)_"/"_$EXTRACT(RCTRANDT,2,3)_" removed."
+26 IF RCFTEST
DO ADDCOMM^RCBEUTRA(RCTRANDA,.RCCOMMNT)
+27 ;
+28 ; build for mailman report
+29 SET ^TMP("RCDPXFIX",$JOB,RCBILLDA,RCTRANDA)=""
+30 QUIT
+31 ;
+32 ;
RECEIPT(RCDPOSIT,RCTRANDT,RCRCPT) ; make changes to receipt file
+1 NEW RCACCT,RCBILLDA,RCDEBTDA,RCPAYDA
+2 SET RCPAYDA=0
FOR
SET RCPAYDA=$ORDER(^RCY(344,RCRCPT,1,RCPAYDA))
if 'RCPAYDA
QUIT
Begin DoDot:1
+3 ; add comment to payment in receipt file
+4 ;**306, removing "duplicate"
+5 ;I RCFTEST S $P(^RCY(344,RCRCPT,1,RCPAYDA,1),"^",2)="Duplicate deposit "_RCDPOSIT_" with transmission date "_$E(RCTRANDT,4,5)_"/"_$E(RCTRANDT,6,7)_"/"_$E(RCTRANDT,2,3)_" removed."
+6 IF RCFTEST
SET $PIECE(^RCY(344,RCRCPT,1,RCPAYDA,1),"^",2)="Deposit "_RCDPOSIT_" with transmission date "_$EXTRACT(RCTRANDT,4,5)_"/"_$EXTRACT(RCTRANDT,6,7)_"/"_$EXTRACT(RCTRANDT,2,3)_" removed."
+7 ;
+8 ; if the account is missing on the payment, then zero out the dollar amount
+9 ; to prevent it from showing as an unlinked payment
+10 SET RCACCT=$PIECE(^RCY(344,RCRCPT,1,RCPAYDA,0),"^",3)
+11 IF 'RCACCT
if RCFTEST
SET $PIECE(^RCY(344,RCRCPT,1,RCPAYDA,0),"^",4)=0
QUIT
+12 ;
+13 ; check acct to see if it has prepayments open with active bills. if so,
+14 ; apply the prepayment to the active bill
+15 SET RCDEBTDA=$ORDER(^RCD(340,"B",RCACCT,0))
IF 'RCDEBTDA
QUIT
+16 ;
+17 ; no prepayments for account
+18 IF '$ORDER(^PRCA(430,"AS",RCDEBTDA,42,0))
QUIT
+19 ;
+20 ; no active bills for account
+21 IF '$ORDER(^PRCA(430,"AS",RCDEBTDA,16,0))
QUIT
+22 ;
+23 ; loop active (16) bills for debtor and apply prepayment
+24 SET RCBILLDA=0
FOR
SET RCBILLDA=$ORDER(^PRCA(430,"AS",RCDEBTDA,16,RCBILLDA))
if 'RCBILLDA
QUIT
Begin DoDot:2
+25 ; no prepayments left, stop loop
+26 IF '$ORDER(^PRCA(430,"AS",RCDEBTDA,42,0))
SET RCBILLDA="A"
QUIT
+27 ;
+28 ; this line is for testing
+29 IF 'RCFTEST
WRITE !,"Prepayment being applied to bill ",RCBILLDA
QUIT
+30 DO PREPAY^RCBEPAYP(RCBILLDA,0)
End DoDot:2
End DoDot:1
+31 QUIT
