source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCKATPD.m@ 1211

Last change on this file since 1211 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1RCKATPD ;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 ;
7EN(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 ;
24PROC ; 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 ;
29APPLY ; 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
36INT 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 ;
59DEC ; - 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 ;
66REFUND ; 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
Note: See TracBrowser for help on using the repository browser.