source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDMCR1A.m@ 619

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

initial load of WorldVistAEHR
File size: 7.2 KB
Line 
1RCDMCR1A ;HEC/SBW - DMC Debt Validity Report ;28/SEP/2007
2 ;;4.5;Accounts Receivable;**253**;Mar 20, 1995;Build 9
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ;This routine is being implemented for the Hold Debt to DMC Project.
6 ;It will do the following:
7 ; Report option in AR to assist users in focusing on reviewing the
8 ; legitimacy of bills for veterans who are SC 50% to 100% or in
9 ; receipt of VA Pension benefits. The report contains information
10 ; on veterans who meet the above criteria and have bills for episodes
11 ; of care within the previous 365 days (or older selected date) with
12 ; a DMC Debt Valid field not flagged as 'YES' or 'NO'. Authorized
13 ; billing staff can run the report to ensure that all bills meeting
14 ; the above criteria are reviewed and if necessary the appropriate
15 ; action is taken as follows:
16 ; Bill is appropriate - Update the Debt Validity Status field to
17 ; 'YES' in order that the bill is referred to DMC via the
18 ; automated process if all other DMC criteria is met
19 ; Bill is inappropriate - Update the Debt Validity Status Field
20 ; to 'NO' and staff will cancel the bill using existing
21 ; functionality
22 ; Inappropriate bill sent to DMC - Staff to initiate action to
23 ; cancel DMC collection or refund payments using existing
24 ; functionality
25 ;
26MAIN ; Initial Interactive Processing
27 N STOPIT,GETBEGDT,BEGDT,EXCEL,RCSCR
28 W !!,"*** Print the Debt Validity Report ***"
29 ;
30 S STOPIT=0 ; quit flag
31 ; Prompts to the user:
32 ;
33 ;Prompt user for Date from which to include bills for episodes of care
34 ;on report
35 S GETBEGDT=$$GETBEGDT^RCDMCUT2("Report To Include Bills For Episodes of Care Beginning With User Selected Date."," Entered Date Must be "_$$FMTE^XLFDT($$FMADD^XLFDT(DT,-365,0,0,0),"1D")_" or older!")
36 Q:+GETBEGDT'>0
37 S BEGDT=$P(GETBEGDT,U,2)
38 ;
39 S EXCEL=$$EXCEL^RCDMCUT2()
40 ;Quit if user Up Arrowed or Timed Out
41 Q:EXCEL="^"
42 D:EXCEL>0 EXMSG^RCDMCUT2
43 D:EXCEL'>0
44 . W !!,"This report may take a while to process. It is recommended that"
45 . W !,"you Queue this report to a device that is 132 characters wide."
46 ;
47 D DEVICE^RCDMCUT2("RUN^RCDMCR1A","DMC Debt Validity Report Process",.STOPIT,.RCSCR,BEGDT,EXCEL)
48 Q:STOPIT>0!($D(ZTQUEUED))
49 D RUN^RCDMCR1A
50 I STOPIT'=2 D PAUSE2^RCDMCUT2
51 Q
52 ;
53QUERPT ; Initial Taskman Scheduled Queued processing
54 N STOPIT,EXCEL,RCSCR,BEGDT
55 S STOPIT=0,EXCEL="",RCSCR=""
56 ;
57 ;Get the "NUMBER OF DAYS FOR DMC REPORTS" site parameter in the AR Site
58 ;Parameter (#342) file.
59 S BEGDT=$$GETRDAY^RCMSITE
60 ;If parameter value not greater than 364 day set default to 365 days
61 S:BEGDT'>364 BEGDT=365
62 ;Set report begin date to past date using Number of Days for DMC reports
63 S BEGDT=$$FMADD^XLFDT(DT,0-BEGDT,0,0,0)
64 ;
65 D RUN^RCDMCR1A
66 Q
67 ;
68RUN ;Get data and Print it out
69 ;If queued ensure you delete it from the TASKS file
70 I $D(ZTQUEUED) S ZTREQ="@"
71 N RCPAGE
72 ;If not passed date, default to get data 365 old
73 I $G(BEGDT)'>0 S BEGDT=$$FMADD^XLFDT(DT,-365,0,0,0)
74 K ^TMP($J,"RCDMCR1")
75 S RCPAGE=0
76 ; Collect the data in ^TMP
77 D COLLECT^RCDMCR1B(.STOPIT,BEGDT)
78 Q:$G(STOPIT)>0
79 U IO
80 ; Print Report using data in ^TMP
81 D REPORT
82 I 'RCSCR W !,@IOF
83 D ^%ZISC
84 K ^TMP($J,"RCDMCR1")
85 K EXCEL,RCSCR,TESTDATE
86 Q
87 ;
88REPORT ;Print report
89 N RUNDATE,FULLHDR,STATUS,IEN,NAME,SSN,NAMEPRT,BILLNO,NODE
90 N CNUM,CLOC,ELIG,ELIGDT,RXDT,OPTDT,DISCHDT,DMCREFDT,DMCVALID
91 S RUNDATE=$$FMTE^XLFDT($$NOW^XLFDT,"9MP")
92 ;Print header with field headers
93 S FULLHDR=1
94 D HDR
95 I +$D(^TMP($J,"RCDMCR1"))'>0 W !,"No data meets the criteria." Q
96 S NAME=""
97 F S NAME=$O(^TMP($J,"RCDMCR1","DETAIL",NAME)) Q:NAME']"" D Q:STOPIT
98 . S SSN=""
99 . F S SSN=$O(^TMP($J,"RCDMCR1","DETAIL",NAME,SSN)) Q:SSN']"" D Q:STOPIT
100 . . ;NAMEPRT - Use to only print Name & SSN once for multiple bills
101 . . S NAMEPRT=1
102 . . S BILLNO=""
103 . . F S BILLNO=$O(^TMP($J,"RCDMCR1","DETAIL",NAME,SSN,BILLNO)) Q:BILLNO']"" D Q:STOPIT
104 . . . S NODE=$G(^TMP($J,"RCDMCR1","DETAIL",NAME,SSN,BILLNO))
105 . . . S CNUM=$P(NODE,U,1),CLOC=$P(NODE,U,2),ELIG=$P(NODE,U,3)
106 . . . S ELIGDT=$P(NODE,U,4),RXDT=$P(NODE,U,5),OPTDT=$P(NODE,U,6)
107 . . . S DISCHDT=$P(NODE,U,7),DMCREFDT=$P(NODE,U,8),DMCVALID=$P(NODE,U,9)
108 . . . S STATUS=$P(NODE,U,10)
109 . . . I EXCEL'>0 D WRLINE Q
110 . . . I EXCEL>0 D WRLINE2 Q
111 ;Don't print summary if user ^ out
112 Q:STOPIT
113 ;Don't print field headers
114 S FULLHDR=0
115 ;Ensure all Summary data fits on page
116 D CHKP(9) Q:STOPIT
117 W !!,"SUMMARY - BILLS REFERRED TO DMC"
118 D ULINE^RCDMCUT2("-",55)
119 W !,"Total Number of Bills Referred: ",$J($FN($G(^TMP($J,"RCDMCR1","SUM-BILL")),",P"),13)
120 W !,"Total Number of unique veterans referred: ",$J($FN($G(^TMP($J,"RCDMCR1","SUM-VET")),",P"),13)
121 W !,"Total Account Receivable Dollars referred: ",$J("$"_$FN($G(^TMP($J,"RCDMCR1","SUM-$")),",P"),13)
122 ;Ensure all Summary data fits on page
123 D CHKP(9) Q:STOPIT
124 W !!,"SUMMARY - TOTAL BILLS"
125 D ULINE^RCDMCUT2("-",46)
126 W !,"Total Number of Bills: ",$J($FN($G(^TMP($J,"RCDMCR1","TOT-BILL")),",P"),13)
127 W !,"Total Number of unique veterans: ",$J($FN($G(^TMP($J,"RCDMCR1","TOT-VET")),",P"),13)
128 W !,"Total Account Receivable Dollars: ",$J("$"_$FN($G(^TMP($J,"RCDMCR1","TOT-$")),",P"),13)
129 ;
130 Q
131 ;
132WRLINE ; Write the data formated report line
133 D CHKP() Q:STOPIT
134 ;If Multiple Bills for Vet only print Name & SSN for 1st record on page
135 W !
136 I NAMEPRT>0 D
137 . W $E(NAME,1,16)
138 . W ?18,SSN
139 . W ?25,CNUM
140 . W ?37,CLOC
141 . W ?44,ELIG
142 . Q:ELIGDT>0
143 . S NAMEPRT=0
144 W ?60,BILLNO
145 W ?73,$$STRIP^XLFSTR($$FMTE^XLFDT(RXDT,"8D")," ")
146 W ?83,$$STRIP^XLFSTR($$FMTE^XLFDT(OPTDT,"8D")," ")
147 W ?92,$$STRIP^XLFSTR($$FMTE^XLFDT(DISCHDT,"8D")," ")
148 W ?101,DMCVALID
149 W ?110,$E(STATUS,1,9)
150 W ?121,$$STRIP^XLFSTR($$FMTE^XLFDT(DMCREFDT,"8D")," ")
151 I NAMEPRT>0,ELIGDT>0 W !?44,$$STRIP^XLFSTR($$FMTE^XLFDT(ELIGDT,"8D")," ") S NAMEPRT=0
152 Q
153 ;
154WRLINE2 ; Write the Excel report line
155 W !
156 W NAME_U
157 W SSN_U
158 W CNUM_U
159 W CLOC_U
160 W ELIG_U
161 W $$FMTE^XLFDT(ELIGDT,"9D")_U
162 W BILLNO_U
163 W $$FMTE^XLFDT(RXDT,"9D")_U
164 W $$FMTE^XLFDT(OPTDT,"9D")_U
165 W $$FMTE^XLFDT(DISCHDT,"9D")_U
166 W DMCVALID_U
167 W STATUS_U
168 W $$FMTE^XLFDT(DMCREFDT,"9D")
169 Q
170 ;
171CHKP(FOOTER) ;Check for End of Page
172 ;INPUT
173 ; FOOTER - Footer value. Optional. Default to 4 if nothing passed
174 I $G(FOOTER)'>0 S FOOTER=4
175 I $Y>(IOSL-FOOTER) D:RCSCR PAUSE^RCDMCUT2 Q:STOPIT D HDR
176 Q
177 ;
178HDR ;Print Report Header
179 ;NAMEPRT - Use to only print Name & SSN once for multiple bills
180 S NAMEPRT=1
181 S RCPAGE=RCPAGE+1
182 W @IOF,"DMC Debt Validity Report"
183 W ?40,"Run Date: ",RUNDATE
184 W ?72,"Episode of Care Data from ",$$FMTE^XLFDT(BEGDT,"9D")
185 W ?115,"Page: "_RCPAGE
186 ;If summary data print underline and quit. Don't need field headers.
187 I FULLHDR'>0 D ULINE^RCDMCUT2("=",$G(IOM)) Q
188 ;Print to screen or printer
189 I EXCEL'>0 D
190 . W !!?25,"Claim",?37,"Claim",?44,"Eligibility/",?60,"Bill",?73,"RX Fill/",?83,"Outpat",?92,"Dischar",?101,"DMC Debt",?121,"DMC Ref"
191 . W !,"Veteran Name",?18,"SSN",?25,"Number",?37,"Loc.",?44,"SC Eff. Date",?60,"Number",?73,"ReFill Dt",?83,"Visit Dt",?92,"Date",?101,"Valid",?110,"Status",?121,"Date"
192 . D ULINE^RCDMCUT2("=",$G(IOM))
193 ;Export to Delimited Excel format
194 I EXCEL>0 D
195 . W !!,"Veteran Name",U,"SSN",U,"Claim #",U,"Claim Loc",U,"Eligibility",U,"SC Eff Date",U,"Bill #",U,"RX Fill",U,"Outpat Visit Date",U,"Discharge Date",U,"DMC Debt Valid",U,"Status",U,"DMC Refer Date"
196 Q
197 ;
Note: See TracBrowser for help on using the repository browser.