74 lines
2.5 KiB
Mathematica
74 lines
2.5 KiB
Mathematica
RCKATPD ;ALB/CPM/TJK - ADJUST ACCOUNTS FOR KATRINA VETS (CON'T) - 03-MAR-06
|
|
;;4.5;Accounts Receivable;**241**;Mar 20, 1995
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
Q
|
|
;
|
|
;
|
|
EN(ACCT,BUCKET,RCMSG) ; Entry point to credit an account for a Katrina vet
|
|
; Input: ACCT -- value of .01 field for debtor in file 340
|
|
; BUCKET -- Amount to credit the account
|
|
; RCMSG -- Bill or transaction comment
|
|
;
|
|
N DFN,RCDEBTDA,RCCOM
|
|
S DFN=+ACCT,RCDEBTDA=$$DEBT^RCEVUTL(ACCT)
|
|
I 'DFN!($G(^DPT(DFN,0))="") Q
|
|
K ^TMP($J)
|
|
N BILL,B0,OLDBAL,PREPAY,TRAN,TDATE,T0,T1,TRAMT,X,TTYPE,STATUS,BN7
|
|
N DECAMT,EXTOT,I,PRCAEN,DIC,DIE,DA,DR,MSG,PERROR,NBILL,NTRAN,MSGCNTS,ERR
|
|
S PREPAY=$O(^PRCA(430.2,"B","PREPAYMENT",0)),RCCOM(1)=RCMSG
|
|
F STATUS=16,42 S BILL=0 F S BILL=$O(^PRCA(430,"AS",RCDEBTDA,STATUS,BILL)) Q:'BILL!'BUCKET D PROC,APPLY:OLDBAL
|
|
D REFUND:BUCKET
|
|
S ERR=$G(PERROR) K ^TMP($J)
|
|
Q
|
|
;
|
|
PROC ; Determine the bill's balance
|
|
S B0=$G(^PRCA(430,BILL,0)),BN7=$G(^(7))
|
|
S OLDBAL=0 F I=1:1:5 S OLDBAL=OLDBAL+$P(BN7,U,I)
|
|
Q
|
|
;
|
|
APPLY ; Exempt interest and decrease a bill
|
|
S EXTOT=0 F I=2:1:5 S EXTOT=EXTOT+$P(BN7,U,I)
|
|
;
|
|
; - interest balance is zero - do a decrease
|
|
G DEC:'EXTOT
|
|
;
|
|
S TRAMT=0 S:EXTOT'<BUCKET EXTOT=BUCKET
|
|
INT F I=5:-1:2 Q:'EXTOT I $P(BN7,U,I) D
|
|
.S X=$P(BN7,U,I),DECAMT=$S(X>BUCKET:BUCKET,1:X)
|
|
.S $P(BN7,U,I)=$P(BN7,U,I)-DECAMT,BUCKET=BUCKET-DECAMT
|
|
.S EXTOT=EXTOT-DECAMT,TRAMT=TRAMT+DECAMT
|
|
S OLDBAL=OLDBAL-TRAMT
|
|
;
|
|
; - create exemption transaction
|
|
D SETTR^PRCAUTL
|
|
S TTYPE=14,DIE="^PRCA(433,",DA=PRCAEN
|
|
S DR=".03////"_BILL_";11////"_DT_";12////"_TTYPE_";15///"_TRAMT_";41///"_RCMSG_";89///1;4///2"
|
|
S DIC=DIE D ^DIE
|
|
K DA,DIC,DIE,DR,TRAMT
|
|
;
|
|
; - update the balance of the bill
|
|
S $P(^PRCA(430,BILL,7),U,2,5)=$P(BN7,U,2)_U_$P(BN7,U,3)_U_$P(BN7,U,4)_U_$P(BN7,U,5)
|
|
;
|
|
; - if the bill was decreased by its entire balance, set the
|
|
; bill status to Cancellation
|
|
I 'OLDBAL D CHGSTAT^RCBEUBIL(BILL,39),ADDCOMM^RCBEUBIL(BILL,.RCCOM) Q
|
|
;
|
|
; - no need for decrease if the amount to credit the account is zero
|
|
Q:'BUCKET
|
|
;
|
|
DEC ; - create a decrease adjustment
|
|
S PRCAEN=0,DECAMT=BUCKET
|
|
D DEC^PRCASER1(BILL,.DECAMT,DUZ,RCMSG,"",.PRCAEN)
|
|
S BUCKET=DECAMT
|
|
Q
|
|
;
|
|
;
|
|
REFUND ; Create a prepayment in an Open status
|
|
S PERROR="" D EN^PRCAPAY3(DFN_";DPT(",BUCKET,DT,DUZ,"","","",.PERROR)
|
|
Q:PERROR]""
|
|
;
|
|
; - find the Open prepayment just increased to add a comment
|
|
S NBILL=0 F S NBILL=$O(^PRCA(430,"AS",RCDEBTDA,$O(^PRCA(430.3,"AC",112,0)),NBILL)) Q:'NBILL I $P(^PRCA(430,NBILL,0),U,2)=PREPAY Q
|
|
I NBILL D ADDCOMM^RCBEUBIL(NBILL,.RCCOM)
|
|
Q
|