source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCBEUBIL.m@ 975

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

initial load of WorldVistAEHR

File size: 4.5 KB
Line 
1RCBEUBIL ;WISC/RFJ-utilties for bills (in file 430) ;1 Jun 00
2 ;;4.5;Accounts Receivable;**153,226**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7GETABILL() ; select an active bill
8 N RCBILLDA,RCCAT,RCCATEG,STATUS
9 F D Q:RCBILLDA
10 . W !! S RCBILLDA=$$SELBILL^RCDPBTLM
11 . I RCBILLDA=0 S RCBILLDA=-1 Q
12 . I RCBILLDA<1 Q
13 . ; bill must be active
14 . S STATUS=$P($G(^PRCA(430,RCBILLDA,0)),"^",8)
15 . I STATUS'=16,STATUS'=42 W !,"THIS IS NOT AN ACTIVE BILL !",! S RCBILLDA=0 Q
16 . ;
17 . ; determine if bill can be adjusted based on category
18 . K RCCAT D RCCAT^RCRCUTL(.RCCAT) ;returns rccat(category) array
19 . S RCCATEG=+$P(^PRCA(430,RCBILLDA,0),"^",2)
20 . I +$G(RCCAT(RCCATEG))=1,$$REFST^RCRCUTL(RCBILLDA) W !!,"YOU CANNOT USE THIS OPTION TO ADJUST REFERRED "_$P($G(RCCAT(RCCATEG)),"^",2)_" BILLS !",! S RCBILLDA=0 Q
21 . ;
22 . I RCCATEG=26 W !,"YOU CANNOT ADJUST A PREPAYMENT BILL !",! S RCBILLDA=0 Q
23 Q RCBILLDA
24 ;
25 ;
26EDIT430(RCBILLDA,DR) ; edit the fields in 430 with the DR string passed
27 I '$D(^PRCA(430,RCBILLDA)) Q
28 N %,D,D0,D1,DA,DDH,DI,DIC,DICR,DIE,DIG,DIH,DIU,DIV,DIW,DQ,J,X,Y
29 S (DIC,DIE)="^PRCA(430,",DA=RCBILLDA
30 D ^DIE
31 ; user pressed up-arrow
32 I $D(Y) Q "0^BILL FIELDS NOT UPDATED"
33 Q 1
34 ;
35 ;
36CHGSTAT(RCBILLDA,STATUS) ; change the current status
37 I '$D(^PRCA(430,RCBILLDA,0)) Q
38 ; if the current status equals the new status, quit
39 I $P(^PRCA(430,RCBILLDA,0),"^",8)=STATUS Q
40 ; if the status not defined in file 430.3, quit
41 I '$D(^PRCA(430.3,STATUS,0)) Q
42 N %,D,D0,DA,DI,DIC,DICR,DIE,DIG,DIH,DIU,DIV,DIW,DQ,DR,PREVSTAT,X,Y
43 S (DIC,DIE)="^PRCA(430,",DA=RCBILLDA
44 ; build DR string
45 S DR=""
46 ; get the current status and set to previous status
47 S PREVSTAT=$P($G(^PRCA(430,RCBILLDA,0)),"^",8)
48 ; if previous status equal to new status, quit
49 I PREVSTAT=STATUS Q
50 I PREVSTAT S DR=DR_"95////"_PREVSTAT_";"
51 S DR=DR_"8////"_STATUS_";" ;current status
52 S DR=DR_"17////"_$G(DUZ)_";" ;status updated by
53 D ^DIE
54 Q
55 ;
56 ;
57SETRCDOJ(RCBILLDA,RCTRANDA,RCDOJ) ; set the bill and transaction to rc or doj
58 ; rcdoj = code RC or DOJ
59 N D,D0,DA,DI,DIC,DIE,DQ,DR,X,Y
60 S (DIC,DIE)="^PRCA(430,",DA=RCBILLDA
61 S DR="65////"_RCDOJ_";"
62 D ^DIE
63 ;
64 S (DIC,DIE)="^PRCA(433,",DA=RCTRANDA
65 S DR="7////"_RCDOJ_";"
66 D ^DIE
67 Q
68 ;
69 ;
70SETBAL(RCTRANDA) ; set the bills balance by adding value of transaction
71 N RCBILLDA,RCDATA7,VALUE
72 S RCBILLDA=$P($G(^PRCA(433,RCTRANDA,0)),"^",2) I 'RCBILLDA Q
73 ; get the value of the transaction
74 S VALUE=$P($$TRANVALU^RCDPBTLM(RCTRANDA),"^",2,6)
75 ; there is no value on the transaction
76 I $TR(VALUE,"^0")="" Q
77 ;
78 S RCDATA7=$G(^PRCA(430,RCBILLDA,7))
79 S $P(RCDATA7,"^",1)=$P(RCDATA7,"^",1)+$P(VALUE,"^",1) ; principal
80 S $P(RCDATA7,"^",2)=$P(RCDATA7,"^",2)+$P(VALUE,"^",2) ; interest
81 S $P(RCDATA7,"^",3)=$P(RCDATA7,"^",3)+$P(VALUE,"^",3) ; admin
82 S $P(RCDATA7,"^",4)=$P(RCDATA7,"^",4)+$P(VALUE,"^",4) ; marshal fee
83 S $P(RCDATA7,"^",5)=$P(RCDATA7,"^",5)+$P(VALUE,"^",5) ; court cost
84 S $P(^PRCA(430,RCBILLDA,7),"^",1,5)=$P(RCDATA7,"^",1,5)
85 Q
86 ;
87 ;
88FYMULT(RCTRANDA) ; update the fiscal year multiple for bill
89 ; to equal the fiscal year multiple for transaction in file 433
90 N RCBILLDA,FYDA
91 S RCBILLDA=$P($G(^PRCA(433,RCTRANDA,0)),"^",2) I 'RCBILLDA Q
92 S FYDA=0
93 F S FYDA=$O(^PRCA(433,RCTRANDA,4,FYDA)) Q:'FYDA D
94 . I $D(^PRCA(430,RCBILLDA,2,FYDA,0)) S $P(^PRCA(430,RCBILLDA,2,FYDA,0),"^",2)=$P(^PRCA(433,RCTRANDA,4,FYDA,0),"^",2)
95 Q
96 ;
97 ;
98SHOWBILL(RCBILLDA) ; show data for bill
99 N DATA7
100 S DATA7=$G(^PRCA(430,RCBILLDA,7))
101 W !?8,"Principal Balance: ",$J($P(DATA7,"^"),9,2)
102 W !?8," Interest Balance: ",$J($P(DATA7,"^",2),9,2)
103 W !?8," Admin Balance: ",$J($P(DATA7,"^",3)+$P(DATA7,"^",4)+$P(DATA7,"^",5),9,2)
104 W !?27,"---------"
105 W !?8," TOTAL Balance: ",$J($P(DATA7,"^")+$P(DATA7,"^",2)+$P(DATA7,"^",3)+$P(DATA7,"^",4)+$P(DATA7,"^",5),9,2)
106 Q
107 ;
108 ;
109ADDCOMM(RCBILLDA,COMMENT) ; automatically put a comment on a bill
110 ; comment in the array comment(1)=first line
111 ; comment(2)=second line
112 N CURRLINE,LINE
113 ; get the last line
114 S CURRLINE=$O(^PRCA(430,RCBILLDA,10,99999999),-1)
115 ; if comment already on transaction, add a blank line and
116 ; date time of new comment
117 I CURRLINE D
118 . S CURRLINE=CURRLINE+1,^PRCA(430,RCBILLDA,10,CURRLINE,0)=" "
119 . S CURRLINE=CURRLINE+1,^PRCA(430,RCBILLDA,10,CURRLINE,0)="Comment added on: "_$$FMTE^XLFDT($$NOW^XLFDT)
120 ; add new lines
121 F LINE=1:1 Q:'$D(COMMENT(LINE)) S ^PRCA(430,RCBILLDA,10,CURRLINE+LINE,0)=COMMENT(LINE)
122 ; set the 0th node
123 S ^PRCA(430,RCBILLDA,10,0)="^^"_(CURRLINE+LINE-1)_"^"_(CURRLINE+LINE-1)_"^"_DT_"^"
124 Q
Note: See TracBrowser for help on using the repository browser.