source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCRJRBDT.m@ 770

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

initial load of FOIAVistA 6/30/08 version
File size: 7.7 KB
Line 
1RCRJRBDT ;WISC/RFJ-bad debt retransmit ;1 Feb 98
2 ;;4.5;Accounts Receivable;**101,170,191,138,239**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;
6 ; - deactivate this option with patch PRCA*4.5*239
7 W !!,"This option may no longer be used to retransmit the Bad Debt"
8 W !,"allowance estimates to FMS."
9 W !!,"Please use the option 'Monthly NDB, SV and WR Regenerate' to"
10 W !,"recalculate the allowance estimates and transmit them to FMS.",!!
11 ;
12 S DIR(0)="E" D ^DIR K DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
13 ;
14 Q
15 ;
16 ;
17 N DA347,DATEMOYR,FMSDOCNO,GECSDATA,RCRJFSV
18 ; the date of the report is for previous month if the DT is before the EOAM date of the current month, it is for the current month if the date is after the EOAM cut-off date.
19 I $E(DT,6,7)'>$E($$LDATE^RCRJR(DT),6,7) S DATEMOYR=$$PREVMONT^RCRJRBD(DT)
20 I $E(DT,6,7)>$E($$LDATE^RCRJR(DT),6,7) S DATEMOYR=$E($$LDATE^RCRJR(DT),1,5)_"00"
21 ;S DATEMOYR=$$PREVMONT^RCRJRBD(DT)
22 W !!,"This option will retransmit the Bad Debt documents to FMS (SV23, SV27, SV2B)."
23 ;
24 ;I +$E(DT,6,7)<$$WD3^RCRJRBD D Q
25 I $E(DT,6,7)<$E($$LDATE^RCRJR(DT),6,7)!($E(DT,6,7)'<$E($$LDAY^RCRJR(DT),6,7)) D Q
26 . W !,"The FMS documents will be automatically sent to FMS on the second to last ",!,"workday of this month."
27 ; try and find SV document to see if its accepted
28 S FMSDOCNO=""
29 K GECSDATA
30 S DA347=$O(^RC(347,"D","SV-"_$E(DATEMOYR,1,5)_"01",0))
31 I DA347 S FMSDOCNO=$P($G(^RC(347,DA347,0)),"^",9)
32 ; if there is an entry, find the code sheet in gcs to rebuild
33 ; gecsdata will be the ien for file 2100.1
34 I FMSDOCNO'="" D DATA^GECSSGET(FMSDOCNO,0)
35 I $G(GECSDATA) D
36 . W !!,"The SV document has been transmitted to fms, document number: "_FMSDOCNO
37 . I $E($G(GECSDATA(2100.1,GECSDATA,3,"E")))="A" D Q
38 . . W !,"The SV document has been ACCEPTED in FMS and will not be resent."
39 . . S RCRJFSV=1
40 . W !,"The SV document has NOT been ACCEPTED and will be RETRANSMITTED."
41 I $G(RCRJFSV) Q
42 ;
43 I $$ASKOKAY(DATEMOYR)'=1 Q
44 ;
45 ; make sure this code is not executed.
46 ;W !!,"Re-sending the documents to FMS ..."
47 ;D BADDEBT^RCXFMSSV
48 ;W " Done.",!,"The Bad Debt Report will be sent to the G.FMS mail group."
49 Q
50 ;
51 ;
52ASKOKAY(DATEMOYR) ; ask if its okay
53 ; 1 is yes, otherwise no
54 N DIR,DIQ2,DTOUT,DUOUT,X,Y
55 S Y=DATEMOYR D DD^%DT
56 S DIR(0)="YO",DIR("B")="NO"
57 S DIR("A")=" Are you SURE you want to resend the Bad Debt Report for "_Y
58 W ! D ^DIR
59 I $G(DTOUT)!($G(DUOUT)) S Y=-1
60 Q Y
61 ;
62 ;
63ENDOFREP ; print end of bad debt report footnotes
64 ; called from rcrjrbdr
65 ;
66 ; print footnote
67 S Y=RCRJDATE D DD^%DT S ENDDATE=Y
68 F %=1:1 S DATA=$P($T(FOOTNOTE+%),";",3,99) Q:DATA="" D
69 . I DATA["DATEREPT" S DATA=$P(DATA,"DATEREPT")_DATEREPT_$P(DATA,"DATEREPT",2)
70 . I DATA["ENDDATE" S DATA=$P(DATA,"ENDDATE")_ENDDATE_$P(DATA,"ENDDATE",2)
71 . D SETLINE^RCRJRBDR(DATA)
72 Q
73 ;
74 ;
75FOOTNOTE ; report footnotes (from rcrjrbdr)
76 ;;(1) Calculated Percentages and the Allowance for Contract Adj - Third Party
77 ;; for SGL 1339 are based on bills created prior to the activation of the
78 ;; Medicare Remittance Advice software. Over time, there will no longer be
79 ;; any bills in this category.
80 ;;
81 ;;(2) Calculated Percentages and the Allowance for Contract Adj - Third Party
82 ;; for SGL 133N are based on non-Medicare WNR bills created after the
83 ;; activation of the Medicare Remittance Advice software.
84 ;;
85 ;;(3) The "Allowance Estimate for DATEREPT" is the dollar value estimated
86 ;; as the Allowance for Bad Debt or Contract Adjustment for the month.
87 ;;
88 ;;(4) The "Bad Debt Write-Off (Plus)" is the actual write-offs or contract
89 ;; adjustments accomplished from FEB 1,1998 thru ENDDATE.
90 ;;
91 ;;(5) The "Transmitted Amount to FMS for Month" is the sum of (3) and (4).
92 ;; The transmitted dollar value is normally a credit value.
93 ;;
94 ;;(6) Facilities are responsible for reporting monthly accrued unbilled
95 ;; amounts. When such amounts are identified and reported, a portion of
96 ;; those dollars should be reported as uncollectable. The estimated
97 ;; uncollectable value of the unbilled amounts should be included as part
98 ;; of the facility's monthly allowance for bad debt or contract adjustments.
99 ;; The AR Override Option should be used to adjust the value provided to
100 ;; report the estimated uncollectable accrued unbilled amounts for the
101 ;; month. Facilities may wish to consider using the allowance percentages
102 ;; provided with this report, if no other means of determining the
103 ;; estimated allowance for the accrued unbilled amount is acceptable.
104 ;;
105 ;;(7) Only members in the facility's local RC AR DATA COLLECTOR mail group
106 ;; will receive this report.
107 ;
108 ;
109 ;
110BDR ; Compile new Bad Debt Report.
111 ; This code will be used to compile the new Bad Debt Report.
112 ; This routine is invokved by routine RCRJRDBR when the Bad
113 ; Debt Report needs to be printed.
114 ;
115 ; Variable input: LINE -- set to 0
116 ; SPACE -- set to 81 space characters
117 ; DATEREPT -- formatted month and year
118 ;
119 N RCARR,RCX,RCD,RCDATA,RCREC,X
120 D SETLINE(" ")
121 D SETLINE($E(SPACE,1,32)_"Bad Debt Report")
122 D SETLINE($E(SPACE,1,13)_"Allowance for Bad Debt and Contract Adjustment Report")
123 D SETLINE($E(SPACE,1,27)_"for the month of "_DATEREPT)
124 I $D(RCRJFXSV) D
125 . D SETLINE(" ")
126 . I $E(RCRJFXSV,1,2)="SV" D SETLINE($E(SPACE,1,13)_"***** Report sent to FMS, doc id: "_RCRJFXSV_" *****") Q
127 . ; report errored out or did not get generated to fms
128 . D SETLINE($E(SPACE,1,10)_"***** NOTICE: Report was NOT sent to FMS, the message is *****")
129 . D SETLINE($E(SPACE,1,10)_"***** "_RCRJFXSV_" *****")
130 ;
131 ; show mccf
132 D SETLINE(" ")
133 D SETLINE($E(SPACE,1,26)_"Medical Care Collection Fund")
134 D SETLINE($E(SPACE,1,20)_" Funds 528701; 528703; 528704; and 528709")
135 D SETLINE($E(SPACE,1,26)_"----------------------------")
136 D SETLINE(" ")
137 D SETLINE(" ")
138 D SETLINE($E(SPACE,1,57)_"Contract EOM")
139 D SETLINE("FUND - SGL Account Collection% Write-Off% Adjustment% Allowance")
140 D SETLINE(" ")
141 ;
142 ; List the fund/SGLs as:
143 ; Order SGL in file Fund - SGL on report
144 ; ===============================================
145 ; 1 1319.3 528701 - 1319
146 ; 2 1319 528703 - 1319
147 ; 3 1319.4 528704 - 1319
148 ; 4 1339 528704 - 1339
149 ; 5 133N 528704 - 133N
150 ; 6 1338 528704 - 1338
151 ; 7 1319.2 528709 - 1319
152 ;
153 S RCARR(1)="1319.3^528701 - 1319"
154 S RCARR(2)="1319^528703 - 1319"
155 S RCARR(3)="1319.4^528704 - 1319"
156 S RCARR(4)="1339^528704 - 1339"
157 S RCARR(5)="133N^528704 - 133N"
158 S RCARR(6)="1338^528704 - 1338"
159 S RCARR(7)="1319.2^528709 - 1319"
160 ;
161 S RCX="" F S RCX=$O(RCARR(RCX)) Q:RCX="" S RCD=RCARR(RCX) D
162 .S RCDATA=$G(^RC(348.1,+$O(^RC(348.1,"B",$P(RCD,"^"),0)),0))
163 .Q:RCDATA=""
164 .S RCREC=$P(RCD,"^",2)_$J($P(RCDATA,"^",2),21,2)
165 .S RCREC=RCREC_$J($P(RCDATA,"^",3),15,2)
166 .S RCREC=RCREC_$J($P(RCDATA,"^",4),16,2)
167 .S X=+$P(RCDATA,"^",8)
168 .S X=$FN(X,",")_$S(X[".":"",1:".")_$E("00",$L($P(X,".",2))+1,2)
169 .S RCREC=RCREC_$J(X,14)
170 .D SETLINE(RCREC)
171 ;
172 D SETLINE(" ")
173 D SETLINE(" ")
174 D SETLINE("SGL Definitions")
175 D SETLINE(" ")
176 D SETLINE("1319 - Allowance for Bad Debt")
177 D SETLINE("1338 - Allowance for Tort Feasors")
178 D SETLINE("1339 - Allowance for Contract Adjustments pre-MRA (Medicare Remittance Advice)")
179 D SETLINE("133N - Allowance for Contract Adjustments post-MRA")
180 D SETLINE(" ")
181 D SETLINE(" ")
182 D SETLINE("Only members in the facility's local RC AR DATA COLLECTOR mail group")
183 D SETLINE("will receive this report.")
184 Q
185 ;
186SETLINE(DATA) ; build the line for the report
187 S LINE=LINE+1,^TMP($J,"RCRJRCORMM",LINE)=DATA
188 Q
Note: See TracBrowser for help on using the repository browser.