source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPBPLM.m@ 1270

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

initial load of WorldVistAEHR
File size: 7.9 KB
RevLine 
[613]1RCDPBPLM ;WISC/RFJ - bill profile ;1 Jun 99
2 ;;4.5;Accounts Receivable;**114,153,159,241**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;
6 ; called from menu option (19)
7 ;
8 N RCBILLDA,RCDPFXIT
9 ;
10 F D Q:'RCBILLDA
11 . W !! S RCBILLDA=$$SELBILL^RCDPBTLM
12 . I RCBILLDA<1 S RCBILLDA=0 Q
13 . D EN^VALM("RCDP BILL PROFILE")
14 . ; fast exit
15 . I $G(RCDPFXIT) S RCBILLDA=0
16 Q
17 ;
18 ;
19INIT ; initialization for list manager list
20 ; requires rcbillda
21 N BILLED,COMMDA,DATA,PAID,RCDPDATA,RCFYDA,RCLINE,REPTYPE,X1,X2,RCDEBTOR,DFN
22 K ^TMP("RCDPBPLM",$J),^TMP("VALM VIDEO",$J)
23 ;
24 ; fast exit
25 I $G(RCDPFXIT) S VALMQUIT=1 Q
26 ;
27 D DIQ430(RCBILLDA,".01:300")
28 ;
29 ; set the listmanager line number
30 S RCLINE=0
31 ;
32 S DATA=$$ACCNTHDR^RCDPAPLM(RCDPDATA(430,RCBILLDA,9,"I"))
33 S RCLINE=RCLINE+1 D SET("Account: "_$P(DATA,"^")_" "_$P(DATA,"^",2),RCLINE,1,80)
34 D SET($P(DATA,"^",3),RCLINE,60,80)
35 S %="" I $TR($P(DATA,"^",4,9),"^")'="" S %=$P(DATA,"^",4)_", "_$P(DATA,"^",7)_", "_$P(DATA,"^",8)_" "_$P(DATA,"^",9)
36 S RCLINE=RCLINE+1 D SET(" Addr: "_%,RCLINE,1,80)
37 S RCLINE=RCLINE+1 D SET(" Phone: "_$P(DATA,"^",10),RCLINE,1,80)
38 S RCDEBTOR=$P(^PRCA(430,RCBILLDA,0),U,9)
39 I $P(^RCD(340,+RCDEBTOR,0),U)["DPT(" S DFN=+^(0) D
40 . Q:$$EMGRES^DGUTL(DFN)'["K"
41 . S RCLINE=RCLINE+1
42 . D SET("EMERGENCY RESPONSE INDICATOR: HURRICANE KATRINA",RCLINE,1,80)
43 ;
44 ; bill descriptive data
45 S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
46 S RCLINE=RCLINE+1 D SET("Bill Number",RCLINE,1,80,.01,IOUON,IOUOFF)
47 D SET("Category",RCLINE,40,80,2)
48 S RCLINE=RCLINE+1 D SET("Date Prepared",RCLINE,1,80,10)
49 D SET("Status",RCLINE,42,80,8)
50 S RCLINE=RCLINE+1 D SET("Date Activated",RCLINE,1,80,60)
51 S RCLINE=RCLINE+1 D SET("Date Status Up",RCLINE,1,80,14)
52 D SET("By",RCLINE,46,80,17)
53 ;display TP bills Division of Care
54 I "T"=$P($G(^PRCA(430.2,+RCDPDATA(430,RCBILLDA,2,"I"),0)),"^",6) D
55 .S RCDIV=$$DIV^IBJDF2(RCBILLDA) I +RCDIV D
56 ..S RCDIV=$P($G(^DG(40.8,RCDIV,0)),U,1) I RCDIV="" Q
57 ..S RCLINE=RCLINE+1 D SET("Division of Care: "_RCDIV,RCLINE,1,80)
58 S RCLINE=RCLINE+1 D SET("Resulting From",RCLINE,1,80,4.5)
59 I RCDPDATA(430,RCBILLDA,15.1,"E")'="" D
60 . S RCLINE=RCLINE+1 D SET(" Type of Care",RCLINE,1,80,15.1)
61 S RCLINE=RCLINE+1 D SET(" Remark",RCLINE,1,80,15)
62 ; display comments if there
63 I $O(^PRCA(430,RCBILLDA,10,0)) D
64 . S RCLINE=RCLINE+1 D SET("Comments:",RCLINE,1,80)
65 . S COMMDA=0 F S COMMDA=$O(^PRCA(430,RCBILLDA,10,COMMDA)) Q:'COMMDA D
66 . . S RCLINE=RCLINE+1 D SET(" "_$G(^PRCA(430,RCBILLDA,10,COMMDA,0)),RCLINE,1,80)
67 ;
68 ; int/adm rate and date
69 S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
70 S DATA=$$INT^RCMSFN01(RCDPDATA(430,RCBILLDA,10,"I"))
71 S Y=$P(DATA,"^",2) I Y D DD^%DT
72 S RCLINE=RCLINE+1 D SET("Interest Effective Rate Date: "_Y,RCLINE,1,80)
73 D SET(" Annual Rate: "_$P(DATA,"^"),RCLINE,55,80)
74 S DATA=$$ADM^RCMSFN01(RCDPDATA(430,RCBILLDA,10,"I"))
75 S Y=$P(DATA,"^",2) I Y D DD^%DT
76 S RCLINE=RCLINE+1 D SET(" Admin Effective Rate Date: "_Y,RCLINE,1,80)
77 D SET("Monthly Rate: "_$P(DATA,"^"),RCLINE,55,80)
78 S RCLINE=RCLINE+1 D SET(" Last Int/Admin Charge Date",RCLINE,1,80,67)
79 ;
80 ; put bill balances on first line of second screen
81 F RCLINE=RCLINE+1:1:16 D SET(" ",RCLINE,1,80)
82 ;
83 ; bill dollars
84 S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
85 S RCLINE=RCLINE+1 D SET("Bill Balances Billed Paid",RCLINE,1,80,0,IOUON,IOUOFF)
86 S RCLINE=RCLINE+1 D SET(" Principal: "_$J(RCDPDATA(430,RCBILLDA,71,"E"),14,2)_$J(RCDPDATA(430,RCBILLDA,77,"E"),14,2),RCLINE,1,80)
87 D SET(" Original Amt: "_$J(RCDPDATA(430,RCBILLDA,3,"E"),11,2),RCLINE,48,80)
88 S RCLINE=RCLINE+1 D SET(" Interest: "_$J(RCDPDATA(430,RCBILLDA,72,"E"),14,2)_$J(RCDPDATA(430,RCBILLDA,78,"E"),14,2),RCLINE,1,80)
89 I $G(RCDPDATA(430,RCBILLDA,131,"E")) D SET("Medicare Contr Adj: "_$J(RCDPDATA(430,RCBILLDA,131,"E"),11,2),RCLINE,48,80)
90 I RCDPDATA(430,RCBILLDA,74,"E") D
91 . S RCLINE=RCLINE+1 D SET(" Marshall Fee: "_$J(RCDPDATA(430,RCBILLDA,74,"E"),14,2)_$J(RCDPDATA(430,RCBILLDA,79.1,"E"),14,2),RCLINE,1,80)
92 I RCDPDATA(430,RCBILLDA,75,"E") D
93 . S RCLINE=RCLINE+1 D SET(" Court Cost: "_$J(RCDPDATA(430,RCBILLDA,75,"E"),14,2),RCLINE,1,80)
94 S RCLINE=RCLINE+1 D SET("Administrative: "_$J(RCDPDATA(430,RCBILLDA,73,"E"),14,2)_$J(RCDPDATA(430,RCBILLDA,79,"E"),14,2),RCLINE,1,80,0,IOUON,IOUOFF)
95 I $G(RCDPDATA(430,RCBILLDA,132,"E")) D SET("Medicare Unreim Exp: "_$J(RCDPDATA(430,RCBILLDA,132,"E"),11,2),RCLINE,48,80)
96 ; compute totals
97 S BILLED=0 F %=71,72,73,74,75 S BILLED=BILLED+RCDPDATA(430,RCBILLDA,%,"E")
98 S PAID=0 F %=77,78,79,79.1 S PAID=PAID+RCDPDATA(430,RCBILLDA,%,"E")
99 S RCLINE=RCLINE+1 D SET(" Current: "_$J(BILLED,14,2)_$J(PAID,14,2),RCLINE,1,80)
100 ;
101 ; show refund if there
102 I RCDPDATA(430,RCBILLDA,79.18,"E") D
103 . S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
104 . S RCLINE=RCLINE+1 D SET("Refunded Amount",RCLINE,1,80,79.18)
105 . D SET("Date",RCLINE,27,80,79.19)
106 . D SET("By",RCLINE,50,80,79.21)
107 ;
108 ; accounting data
109 S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
110 S RCLINE=RCLINE+1 D SET("Accounting Data",RCLINE,1,80,0,IOUON,IOUOFF)
111 ; fiscal year multiple
112 D SET("Fiscal Year",RCLINE,20,32,0,IOUON,IOUOFF)
113 D SET("Approp Code",RCLINE,34,46,0,IOUON,IOUOFF)
114 D SET("Amount",RCLINE,50,60,0,IOUON,IOUOFF)
115 S RCFYDA=0 F S RCFYDA=$O(^PRCA(430,RCBILLDA,2,RCFYDA)) Q:'RCFYDA D
116 . S DATA=$G(^PRCA(430,RCBILLDA,2,RCFYDA,0))
117 . S RCLINE=RCLINE+1
118 . D SET($J($P(DATA,"^"),30),RCLINE,1,80) ;fiscal year
119 . D SET($J(RCDPDATA(430,RCBILLDA,203,"E"),6),RCLINE,39,45) ;fund
120 . D SET($J($P(DATA,"^",2),8,2),RCLINE,48,80) ;amount
121 ; determine which rsc to display
122 S %=RCDPDATA(430,RCBILLDA,255.1,"E") I %="" S %=RCDPDATA(430,RCBILLDA,255,"E")
123 S RCLINE=RCLINE+1 D SET("Rev Srce Code: "_%,RCLINE,1,80)
124 ;
125 ; collection data
126 S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
127 S RCLINE=RCLINE+1 D SET("Collection Follow up Data",RCLINE,1,80,0,IOUON,IOUOFF)
128 S RCLINE=RCLINE+1 D SET(" Letter1",RCLINE,1,80,61)
129 S RCLINE=RCLINE+1 D SET(" Letter2",RCLINE,1,80,62)
130 S RCLINE=RCLINE+1 D SET(" Letter3",RCLINE,1,80,63)
131 S RCLINE=RCLINE+1 D SET(" Letter4",RCLINE,1,80,68)
132 I RCDPDATA(430,RCBILLDA,68.6,"I") D
133 . S RCLINE=RCLINE+1 D SET(" IRS Letter",RCLINE,1,80,68.6)
134 . D SET("Amount",RCLINE,65,80,68.93)
135 I RCDPDATA(430,RCBILLDA,64,"I") D
136 . S RCLINE=RCLINE+1 D SET("DC/DOJ Ref Date",RCLINE,1,80,64)
137 . D SET("To",RCLINE,40,80,65)
138 . D SET("Amount",RCLINE,65,80,66)
139 ;
140 ; repayment plan (show only if there)
141 I RCDPDATA(430,RCBILLDA,41,"I") D REPAY^RCDPBPLI
142 ;
143 ; irs data (show only if there)
144 I RCDPDATA(430,RCBILLDA,68.7,"I") D IRS^RCDPBPLI
145 ;
146 ; dmc data (show only if there)
147 I RCDPDATA(430,RCBILLDA,121,"I") D DMC^RCDPBPLI
148 ;
149 ; top data (show only if there)
150 I $G(RCDPDATA(430,RCBILLDA,141,"I")) D TOP^RCDPBPLI
151 ;
152 ; get the report type based on category. if third party show
153 ; insurance data
154 S REPTYPE=$P($G(^PRCA(430.2,+RCDPDATA(430,RCBILLDA,2,"I"),0)),"^",6)
155 I REPTYPE="T" D INSUR^RCDPBPLI
156 ;
157 ; report type for employee or vendor, show description field 106
158 I REPTYPE="O"!(REPTYPE="V") D INIT^RCDPBPLI
159 ;
160 ; show transactions and reasons
161 D TRANINIT^RCDPBPLI
162 ;
163 ; set valmcnt to number of lines in the list
164 S VALMCNT=RCLINE
165 D HDR
166 Q
167 ;
168 ;
169HDR ; header code for list manager display
170 ; requires rcbillda
171 S VALMHDR(1)="***** ACCOUNTS RECEIVABLE BILL PROFILE FOR "_$P($G(^PRCA(430,RCBILLDA,0)),"^")_" *****"
172 Q
173 ;
174 ;
175EXIT ; exit list manager option and clean up
176 K ^TMP("RCDPBPLM",$J)
177 Q
178 ;
179 ;
180SET(STRING,LINE,COLBEG,COLEND,FIELD,ON,OFF) ; set array
181 I $G(FIELD) S STRING=STRING_$S(STRING="":"",1:": ")_$G(RCDPDATA(430,RCBILLDA,FIELD,"E"))
182 I STRING="",'$G(FIELD) Q
183 I '$D(@VALMAR@(LINE,0)) D SET^VALM10(LINE,$J("",80))
184 D SET^VALM10(LINE,$$SETSTR^VALM1(STRING,@VALMAR@(LINE,0),COLBEG,COLEND-COLBEG+1))
185 I $G(ON)]""!($G(OFF)]"") D CNTRL^VALM10(LINE,COLBEG,$L(STRING),ON,OFF)
186 Q
187 ;
188 ;
189DIQ430(DA,DR) ; diq call to retrieve data for dr fields in file 430
190 N D0,DIC,DIQ,DIQ2
191 K RCDPDATA(430,DA)
192 S DIQ(0)="IE",DIC="^PRCA(430,",DIQ="RCDPDATA" D EN^DIQ1
193 Q
Note: See TracBrowser for help on using the repository browser.