Routine: RCDPXFIX

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.

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)

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

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)

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

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)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPXFIX   10942     printed  Mar 13, 2025@20:51:20                                                                                                                                                                                                   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

RCDPXFIX.m