PRCAI164 ;ALB/LDB-post init patch 164 ;19 Nov 00
;;4.5;Accounts Receivable;**164**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
; this routine is used to back out an duplicate receipt that has
; been posted to first party bills. it was used to back out a
; lockbox deposit ticket 269296 which was sent twice from Austin
; on november 10 and november 13, 2000.
Q
;
;
START ; start post init
D BMES^XPDUTL(" >> Removing payments for duplicate deposit 269296 ...")
;
N %,RCBILLDA,RCDATA0,RCDPDT,RCFTEST,RCMESSAG,RCRCPT,RCTRAN1,RCTRANDA,X
K ^TMP("PRCAI164",$J)
;
;S RCFTEST=0 ; NO, do not make updates to the database
S RCFTEST=1 ; YES, make changes to the database
;
; set default message to send to user
S RCMESSAG="Duplicate receipt not found for deposit 269296. Patch 164 is installed."
;
; find deposit which was posted erroneously
S RCDPDT=$O(^RCY(344.1,"B",269296,0)) I 'RCDPDT D MAIL^PRCAI16M 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))
. I $P(RCDATA0,"^",3)'=3001113 Q
. ;
. ; patch already installed
. I $P(RCDATA0,"^",10) S RCMESSAG="Patch 164 has already been previously installed." Q
. ;
. ; found deposit/receipt and it needs to be backed out
. S RCMESSAG="Patch 164 has been completely installed."
. ;
. ; 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)
. ;
. ; add comment on payments in receipt
. D ADDCOMM(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^PRCAI16M
K ^TMP("PRCAI164",$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
;
; add comment to transaction
S RCCOMMNT(1)="Incomplete by patch 164 due to duplicate payment processed on deposit 269296"
I RCFTEST D ADDCOMM^RCBEUTRA(RCTRANDA,.RCCOMMNT)
;
; build mailman message
I RCFREPRT S ^TMP("PRCAI164",$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,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
;
; add comment to transaction
S RCCOMMNT(1)="Incomplete by patch 164 due to duplicate payment processed on deposit 269296"
I RCFTEST D ADDCOMM^RCBEUTRA(RCTRANDA,.RCCOMMNT)
;
; build for mailman report
S ^TMP("PRCAI164",$J,RCBILLDA,RCTRANDA)=""
Q
;
;
ADDCOMM(RCRCPT) ; add comment on payments on receipt to show they have been removed
N RCPAYDA
S RCPAYDA=0 F S RCPAYDA=$O(^RCY(344,RCRCPT,1,RCPAYDA)) Q:'RCPAYDA D
. I RCFTEST S $P(^RCY(344,RCRCPT,1,RCPAYDA,1),"^",2)="Payment removed by patch 164 as a duplicate."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCAI164 7847 printed Oct 16, 2024@17:40:51 Page 2
PRCAI164 ;ALB/LDB-post init patch 164 ;19 Nov 00
+1 ;;4.5;Accounts Receivable;**164**;Mar 20, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ; this routine is used to back out an duplicate receipt that has
+5 ; been posted to first party bills. it was used to back out a
+6 ; lockbox deposit ticket 269296 which was sent twice from Austin
+7 ; on november 10 and november 13, 2000.
+8 QUIT
+9 ;
+10 ;
START ; start post init
+1 DO BMES^XPDUTL(" >> Removing payments for duplicate deposit 269296 ...")
+2 ;
+3 NEW %,RCBILLDA,RCDATA0,RCDPDT,RCFTEST,RCMESSAG,RCRCPT,RCTRAN1,RCTRANDA,X
+4 KILL ^TMP("PRCAI164",$JOB)
+5 ;
+6 ;S RCFTEST=0 ; NO, do not make updates to the database
+7 ; YES, make changes to the database
SET RCFTEST=1
+8 ;
+9 ; set default message to send to user
+10 SET RCMESSAG="Duplicate receipt not found for deposit 269296. Patch 164 is installed."
+11 ;
+12 ; find deposit which was posted erroneously
+13 SET RCDPDT=$ORDER(^RCY(344.1,"B",269296,0))
IF 'RCDPDT
DO MAIL^PRCAI16M
QUIT
+14 ;
+15 ; find receipts for deposit
+16 SET RCRCPT=0
FOR
SET RCRCPT=$ORDER(^RCY(344,"AD",RCDPDT,RCRCPT))
if 'RCRCPT
QUIT
Begin DoDot:1
+17 SET RCDATA0=$GET(^RCY(344,RCRCPT,0))
+18 IF $PIECE(RCDATA0,"^",3)'=3001113
QUIT
+19 ;
+20 ; patch already installed
+21 IF $PIECE(RCDATA0,"^",10)
SET RCMESSAG="Patch 164 has already been previously installed."
QUIT
+22 ;
+23 ; found deposit/receipt and it needs to be backed out
+24 SET RCMESSAG="Patch 164 has been completely installed."
+25 ;
+26 ; loop payments made in transaction 433 file
+27 SET RCTRANDA=0
FOR
SET RCTRANDA=$ORDER(^PRCA(433,"AF",$PIECE(RCDATA0,"^"),RCTRANDA))
if 'RCTRANDA
QUIT
Begin DoDot:2
+28 ; transaction is already marked incomplete
+29 IF $PIECE(^PRCA(433,RCTRANDA,0),"^",4)=1
QUIT
+30 ;
+31 ; lock the transaction
+32 LOCK +^PRCA(433,RCTRANDA)
+33 ;
+34 ; get transaction data
+35 SET RCTRAN1=$GET(^PRCA(433,RCTRANDA,1))
+36 SET RCBILLDA=$PIECE(^PRCA(433,RCTRANDA,0),"^",2)
+37 ;
+38 ; lock the bill
+39 LOCK +^PRCA(430,RCBILLDA)
+40 ;
+41 ;
+42 ; transaction type = payment in part (2) or
+43 ; transaction type = payment in full (34)
+44 IF $PIECE(RCTRAN1,"^",2)=2!($PIECE(RCTRAN1,"^",2)=34)
DO PAYMENT(RCTRANDA,1)
+45 ;
+46 ;
+47 ; transaction type = prepayment [increase adjustment (1)]
+48 IF $PIECE(RCTRAN1,"^",2)=1
DO PREPAY
+49 ;
+50 ; unlock the bill and transaction
+51 LOCK -^PRCA(430,RCBILLDA)
+52 LOCK -^PRCA(433,RCTRANDA)
End DoDot:2
+53 ;
+54 ; add comment on payments in receipt
+55 DO ADDCOMM(RCRCPT)
+56 ;
+57 ; set piece 10 in receipt to show patch as being installed
+58 IF RCFTEST
DO NOW^%DTC
SET $PIECE(^RCY(344,RCRCPT,0),"^",10)=%
End DoDot:1
+59 ;
+60 DO MAIL^PRCAI16M
+61 KILL ^TMP("PRCAI164",$JOB)
+62 QUIT
+63 ;
+64 ;
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 ; add comment to transaction
+38 SET RCCOMMNT(1)="Incomplete by patch 164 due to duplicate payment processed on deposit 269296"
+39 IF RCFTEST
DO ADDCOMM^RCBEUTRA(RCTRANDA,.RCCOMMNT)
+40 ;
+41 ; build mailman message
+42 IF RCFREPRT
SET ^TMP("PRCAI164",$JOB,RCBILLDA,RCTRANDA)=""
+43 QUIT
+44 ;
+45 ;
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,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 ; add comment to transaction
+23 SET RCCOMMNT(1)="Incomplete by patch 164 due to duplicate payment processed on deposit 269296"
+24 IF RCFTEST
DO ADDCOMM^RCBEUTRA(RCTRANDA,.RCCOMMNT)
+25 ;
+26 ; build for mailman report
+27 SET ^TMP("PRCAI164",$JOB,RCBILLDA,RCTRANDA)=""
+28 QUIT
+29 ;
+30 ;
ADDCOMM(RCRCPT) ; add comment on payments on receipt to show they have been removed
+1 NEW RCPAYDA
+2 SET RCPAYDA=0
FOR
SET RCPAYDA=$ORDER(^RCY(344,RCRCPT,1,RCPAYDA))
if 'RCPAYDA
QUIT
Begin DoDot:1
+3 IF RCFTEST
SET $PIECE(^RCY(344,RCRCPT,1,RCPAYDA,1),"^",2)="Payment removed by patch 164 as a duplicate."
End DoDot:1
+4 QUIT
