| 1 | RCKATPD ;ALB/CPM/TJK - ADJUST ACCOUNTS FOR KATRINA VETS (CON'T) - 03-MAR-06
|
|---|
| 2 | ;;4.5;Accounts Receivable;**241**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | EN(ACCT,BUCKET,RCMSG) ; Entry point to credit an account for a Katrina vet
|
|---|
| 8 | ; Input: ACCT -- value of .01 field for debtor in file 340
|
|---|
| 9 | ; BUCKET -- Amount to credit the account
|
|---|
| 10 | ; RCMSG -- Bill or transaction comment
|
|---|
| 11 | ;
|
|---|
| 12 | N DFN,RCDEBTDA,RCCOM
|
|---|
| 13 | S DFN=+ACCT,RCDEBTDA=$$DEBT^RCEVUTL(ACCT)
|
|---|
| 14 | I 'DFN!($G(^DPT(DFN,0))="") Q
|
|---|
| 15 | K ^TMP($J)
|
|---|
| 16 | N BILL,B0,OLDBAL,PREPAY,TRAN,TDATE,T0,T1,TRAMT,X,TTYPE,STATUS,BN7
|
|---|
| 17 | N DECAMT,EXTOT,I,PRCAEN,DIC,DIE,DA,DR,MSG,PERROR,NBILL,NTRAN,MSGCNTS,ERR
|
|---|
| 18 | S PREPAY=$O(^PRCA(430.2,"B","PREPAYMENT",0)),RCCOM(1)=RCMSG
|
|---|
| 19 | F STATUS=16,42 S BILL=0 F S BILL=$O(^PRCA(430,"AS",RCDEBTDA,STATUS,BILL)) Q:'BILL!'BUCKET D PROC,APPLY:OLDBAL
|
|---|
| 20 | D REFUND:BUCKET
|
|---|
| 21 | S ERR=$G(PERROR) K ^TMP($J)
|
|---|
| 22 | Q
|
|---|
| 23 | ;
|
|---|
| 24 | PROC ; Determine the bill's balance
|
|---|
| 25 | S B0=$G(^PRCA(430,BILL,0)),BN7=$G(^(7))
|
|---|
| 26 | S OLDBAL=0 F I=1:1:5 S OLDBAL=OLDBAL+$P(BN7,U,I)
|
|---|
| 27 | Q
|
|---|
| 28 | ;
|
|---|
| 29 | APPLY ; Exempt interest and decrease a bill
|
|---|
| 30 | S EXTOT=0 F I=2:1:5 S EXTOT=EXTOT+$P(BN7,U,I)
|
|---|
| 31 | ;
|
|---|
| 32 | ; - interest balance is zero - do a decrease
|
|---|
| 33 | G DEC:'EXTOT
|
|---|
| 34 | ;
|
|---|
| 35 | S TRAMT=0 S:EXTOT'<BUCKET EXTOT=BUCKET
|
|---|
| 36 | INT F I=5:-1:2 Q:'EXTOT I $P(BN7,U,I) D
|
|---|
| 37 | .S X=$P(BN7,U,I),DECAMT=$S(X>BUCKET:BUCKET,1:X)
|
|---|
| 38 | .S $P(BN7,U,I)=$P(BN7,U,I)-DECAMT,BUCKET=BUCKET-DECAMT
|
|---|
| 39 | .S EXTOT=EXTOT-DECAMT,TRAMT=TRAMT+DECAMT
|
|---|
| 40 | S OLDBAL=OLDBAL-TRAMT
|
|---|
| 41 | ;
|
|---|
| 42 | ; - create exemption transaction
|
|---|
| 43 | D SETTR^PRCAUTL
|
|---|
| 44 | S TTYPE=14,DIE="^PRCA(433,",DA=PRCAEN
|
|---|
| 45 | S DR=".03////"_BILL_";11////"_DT_";12////"_TTYPE_";15///"_TRAMT_";41///"_RCMSG_";89///1;4///2"
|
|---|
| 46 | S DIC=DIE D ^DIE
|
|---|
| 47 | K DA,DIC,DIE,DR,TRAMT
|
|---|
| 48 | ;
|
|---|
| 49 | ; - update the balance of the bill
|
|---|
| 50 | 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)
|
|---|
| 51 | ;
|
|---|
| 52 | ; - if the bill was decreased by its entire balance, set the
|
|---|
| 53 | ; bill status to Cancellation
|
|---|
| 54 | I 'OLDBAL D CHGSTAT^RCBEUBIL(BILL,39),ADDCOMM^RCBEUBIL(BILL,.RCCOM) Q
|
|---|
| 55 | ;
|
|---|
| 56 | ; - no need for decrease if the amount to credit the account is zero
|
|---|
| 57 | Q:'BUCKET
|
|---|
| 58 | ;
|
|---|
| 59 | DEC ; - create a decrease adjustment
|
|---|
| 60 | S PRCAEN=0,DECAMT=BUCKET
|
|---|
| 61 | D DEC^PRCASER1(BILL,.DECAMT,DUZ,RCMSG,"",.PRCAEN)
|
|---|
| 62 | S BUCKET=DECAMT
|
|---|
| 63 | Q
|
|---|
| 64 | ;
|
|---|
| 65 | ;
|
|---|
| 66 | REFUND ; Create a prepayment in an Open status
|
|---|
| 67 | S PERROR="" D EN^PRCAPAY3(DFN_";DPT(",BUCKET,DT,DUZ,"","","",.PERROR)
|
|---|
| 68 | Q:PERROR]""
|
|---|
| 69 | ;
|
|---|
| 70 | ; - find the Open prepayment just increased to add a comment
|
|---|
| 71 | 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
|
|---|
| 72 | I NBILL D ADDCOMM^RCBEUBIL(NBILL,.RCCOM)
|
|---|
| 73 | Q
|
|---|
