source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDMCR3A.m@ 1710

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

initial load of WorldVistAEHR

File size: 8.0 KB
RevLine 
[613]1RCDMCR3A ;HEC/SBW - DMC Rated Disability Eligibility Change Report ; 22/OCT/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 neither SC 50% to 100%
9 ; nor in receipt of a VA Pension benefits (Veterans not included on
10 ; the "DMC Debt Validity Report"). The report will contain
11 ; information on veterans who have bills for episodes of care
12 ; within the previous 365 days (or older selected date) and who
13 ; have a new Rated Disability during a user selected time period.
14 ;
15MAIN ; Initial Interactive Processing
16 N STOPIT,EXCEL,RCSCR,GETBEGDT,RDDATE,RCBEGDT,RCENDDT
17 W !!,"*** Print the Rated Disability Eligibility Change Report ***"
18 ;
19 S STOPIT=0 ; quit flag
20 ;Prompt user for Date Range for Rated Disability Eligibility Changes
21 S RDDATE=$$DATE^RCDMCUT2(" Enter the Date Range for Rated Disability Changes.")
22 ;Quit is user up arrowed or timed out
23 Q:RDDATE'>0
24 S RCBEGDT=$P(RDDATE,U,2),RCENDDT=$P(RDDATE,U,3)
25 ;
26 ;Prompt user for Date from which to include bills for episodes of care
27 ;on report
28 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!")
29 ;Quit if user up arrowed or timed out
30 Q:+GETBEGDT'>0
31 S BEGDT=$P(GETBEGDT,U,2)
32 ;
33 ; Prompt user if report will be Excel Delimited format:
34 S EXCEL=$$EXCEL^RCDMCUT2
35 ;Quit is user up arrowed or timed out
36 Q:EXCEL="^"
37 D:EXCEL>0 EXMSG^RCDMCUT2
38 D:EXCEL'>0
39 . W !!,"This report may take a while to process. It is recommended that"
40 . W !,"you Queue this report to a device that is 132 characters wide."
41 ;
42 D DEVICE^RCDMCUT2("RUN^RCDMCR3A","DMC Rated Disability Eligibility Change Report Process",.STOPIT,.RCSCR,BEGDT,EXCEL)
43 Q:STOPIT>0!($D(ZTQUEUED))
44 D RUN^RCDMCR3A
45 I STOPIT'=2 D PAUSE2^RCDMCUT2
46 Q
47 ;
48QUERPT ; Initial Taskman Scheduled Queued processing
49 N STOPIT,EXCEL,RCSCR,BEGDT,RCDAY,RCBEGDT,RCENDDT
50 S STOPIT=0,EXCEL="",RCSCR=""
51 ;
52 ;Get the "NUMBER OF DAYS FOR DMC REPORTS" site parameter in the AR Site
53 ;Parameter (#342) file.
54 S BEGDT=$$GETRDAY^RCMSITE
55 ;If parameter value not greater than 364 day set default to 365 days
56 S:BEGDT'>364 BEGDT=365
57 ;Set report begin date to past date using Number of Days for DMC reports
58 S BEGDT=$$FMADD^XLFDT(DT,0-BEGDT,0,0,0)
59 ;
60 ;Get the # OF DAYS FOR RD ELIG CHG RPT" site parameter in the AR Site
61 ;Parameter (#342) file.
62 S RCDAY=$$GETRDDAY^RCMSITE
63 ;If parameter value not greater than zero default to 31 days
64 S:RCDAY'>0 RCDAY=31
65 ;Set RD Beginning Date with RDDAY a negative value
66 S RCBEGDT=$$FMADD^XLFDT(DT,0-RCDAY,0,0,0)
67 ;Set RD End Date till tomorrow to get all data for today
68 S RCENDDT=$$FMADD^XLFDT(DT,+1,0,0,0)
69 ;
70 D RUN^RCDMCR3A
71 Q
72 ;
73RUN ;Get data and Print it out
74 ;If queued ensure you delete it from the TASKS file
75 I $D(ZTQUEUED) S ZTREQ="@"
76 N RCPAGE
77 ;If not passed date, default to get data 365 old
78 I $G(BEGDT)'>0 S BEGDT=$$FMADD^XLFDT(DT,-365,0,0,0)
79 K ^TMP($J,"RCDMCR3")
80 S RCPAGE=0
81 ; Collect the data in ^TMP
82 D COLLECT^RCDMCR3B(.STOPIT,BEGDT,RCBEGDT,RCENDDT)
83 Q:$G(STOPIT)>0
84 U IO
85 ; Print Report using data in ^TMP
86 D REPORT
87 I 'RCSCR W !,@IOF
88 D ^%ZISC
89 K ^TMP($J,"RCDMCR3")
90 K EXCEL,RCSCR,TESTDATE
91 Q
92 ;
93REPORT ;Print report
94 N RUNDATE,FULLHDR,STATUS,NAME,SSN,CHGDT,RDNAME,RDSEXTRE,BILLNO
95 N NAMEPRT,CHGDTPRT,RDPRT
96 ;
97 S RUNDATE=$$FMTE^XLFDT($$NOW^XLFDT,"9MP")
98 ;Print header with field headers
99 S FULLHDR=1
100 D HDR
101 I +$D(^TMP($J,"RCDMCR3"))'>0 W !,"No data meets the criteria." Q
102 S NAME=""
103 F S NAME=$O(^TMP($J,"RCDMCR3","DETAIL",NAME)) Q:NAME']"" D Q:STOPIT
104 . S SSN=""
105 . F S SSN=$O(^TMP($J,"RCDMCR3","DETAIL",NAME,SSN)) Q:SSN']"" D Q:STOPIT
106 . . ;NAMEPRT - Use to only print Name & SSN once for multiple Vet RDs
107 . . S NAMEPRT=1
108 . . S CHGDT=0
109 . . F S CHGDT=$O(^TMP($J,"RCDMCR3","DETAIL",NAME,SSN,CHGDT)) Q:CHGDT'>0 D Q:STOPIT
110 . . . ;CHGDTPRT - Use to only print RD Change Date once for multiple
111 . . . ; RD Change Dates
112 . . . S CHGDTPRT=1
113 . . . S RDNAME=""
114 . . . F S RDNAME=$O(^TMP($J,"RCDMCR3","DETAIL",NAME,SSN,CHGDT,RDNAME)) Q:RDNAME']"" D Q:STOPIT
115 . . . . S RDSEXTRE=""
116 . . . . F S RDSEXTRE=$O(^TMP($J,"RCDMCR3","DETAIL",NAME,SSN,CHGDT,RDNAME,RDSEXTRE)) Q:RDSEXTRE']"" D Q:STOPIT
117 . . . . . ;CHGDTPRT - Use to only print RD Name once for multiple RD Names
118 . . . . . S RDPRT=1
119 . . . . . S BILLNO=""
120 . . . . . F S BILLNO=$O(^TMP($J,"RCDMCR3","DETAIL",NAME,SSN,CHGDT,RDNAME,RDSEXTRE,BILLNO)) Q:BILLNO']"" D Q:STOPIT
121 . . . . . . N NODE,CNUM,CLOC,RDLEXTRE,RDORGDT,RXDT,OPTDT,DISCHDT
122 . . . . . . N STATUS
123 . . . . . . S NODE=$G(^TMP($J,"RCDMCR3","DETAIL",NAME,SSN,CHGDT,RDNAME,RDSEXTRE,BILLNO))
124 . . . . . . S CNUM=$P(NODE,U,1),CLOC=$P(NODE,U,2)
125 . . . . . . S RDLEXTRE=$P(NODE,U,3)
126 . . . . . . S RDORGDT=$P(NODE,U,4)
127 . . . . . . S RXDT=$P(NODE,U,5),OPTDT=$P(NODE,U,6)
128 . . . . . . S DISCHDT=$P(NODE,U,7)
129 . . . . . . S STATUS=$P(NODE,U,8)
130 . . . . . . I EXCEL'>0 D WRLINE Q
131 . . . . . . I EXCEL>0 D WRLINE2 Q
132 ;Don't print summary if user ^ out
133 Q:STOPIT
134 ;Don't print field headers
135 S FULLHDR=0
136 ;Ensure Summary data all fits on same page
137 D CHKP(9) Q:STOPIT
138 W !!,"SUMMARY"
139 D ULINE^RCDMCUT2("=",48)
140 W !,"Total Number of unique veterans: ",$J($FN($G(^TMP($J,"RCDMCR3","SUM-VET")),",P"),13)
141 W !,"Total Number of Rated Disabilities: ",$J($FN($G(^TMP($J,"RCDMCR3","SUM-RD")),",P"),13)
142 W !,"Total Number of Bills: ",$J($FN($G(^TMP($J,"RCDMCR3","SUM-BILL")),",P"),13)
143 ;
144 Q
145 ;
146WRLINE ; Write the data formated report line
147 D CHKP() Q:STOPIT
148 ;If Multiple Bills for Vet only print Name & SSN for 1st record on page
149 W !
150 I NAMEPRT>0 D
151 . W $E(NAME,1,14)
152 . W ?15,SSN
153 . W ?21,CNUM
154 . W ?32,CLOC
155 . S NAMEPRT=0
156 I CHGDTPRT>0 D
157 . W ?38,$$STRIP^XLFSTR($$FMTE^XLFDT(CHGDT,"8D")," ")
158 . S CHGDTPRT=0
159 I RDPRT>0 D
160 . W ?46,$E(RDNAME,1,29)
161 . W ?77,RDSEXTRE
162 . W ?81,$$STRIP^XLFSTR($$FMTE^XLFDT(RDORGDT,"8D")," ")
163 . S RDPRT=0
164 W ?89,BILLNO
165 W ?101,$$STRIP^XLFSTR($$FMTE^XLFDT(RXDT,"8D")," ")
166 W ?109,$$STRIP^XLFSTR($$FMTE^XLFDT(OPTDT,"8D")," ")
167 W ?118,$$STRIP^XLFSTR($$FMTE^XLFDT(DISCHDT,"8D")," ")
168 W ?126,$E(STATUS,1,6)
169 Q
170 ;
171WRLINE2 ; Write the Excel report line
172 W !
173 W NAME_U
174 W SSN_U
175 W CNUM_U
176 W CLOC_U
177 W $$FMTE^XLFDT(CHGDT,"9D")_U
178 W RDNAME_U
179 W RDLEXTRE_U
180 W $$FMTE^XLFDT(RDORGDT,"9D")_U
181 W BILLNO_U
182 W $$FMTE^XLFDT(RXDT,"9D")_U
183 W $$FMTE^XLFDT(OPTDT,"9D")_U
184 W $$FMTE^XLFDT(DISCHDT,"9D")_U
185 W STATUS_U
186 Q
187 ;
188CHKP(FOOTER) ;Check for End of Page
189 ;INPUT:
190 ; FOOTER - Footer value. Optional. Default to 4 if nothing passed
191 I $G(FOOTER)'>0 S FOOTER=4
192 I $Y>(IOSL-FOOTER) D:RCSCR PAUSE^RCDMCUT2 Q:STOPIT D HDR
193 Q
194 ;
195HDR ;Print Report Header
196 ;NAMEPRT - Use to print Name & SSN once for multiple Vets RDs per page
197 ;CHGDTPRT - Use to print RD Change Date once for multiple RDs per page
198 ;RDPRT - Use to print RD Name once for multiple RD names per page
199 S NAMEPRT=1,CHGDTPRT=1,RDPRT=1
200 S RCPAGE=RCPAGE+1
201 W @IOF,"Rated Disability Eligibility Change Report -- Run Date: ",RUNDATE
202 W " -- Episode of Care Data from ",$$FMTE^XLFDT(BEGDT,"9D")
203 W ?122,"Page: "_RCPAGE
204 W !?5,"RD Change Dates from ",$$FMTE^XLFDT(RCBEGDT,"9D")," to ",$$FMTE^XLFDT(RCENDDT,"9D")
205 ;Quit if printing summary data. Don't need field headers
206 I FULLHDR'>0 D ULINE^RCDMCUT2("=",$G(IOM)) Q
207 ;Print to screen or printer
208 I EXCEL'>0 D
209 . W !?21,"Claim",?32,"Claim",?38,"RD Chg",?74,"Extre-",?81,"RD Orig",?89,"BILL",?101,"RX Fill",?109,"Outpat",?118,"Dischar"
210 . W !,"Veteran Name",?15,"SSN",?21,"Number",?32,"Loc.",?38,"Date",?46,"RD Name",?75,"mity",?81,"Date",?89,"Number",?101,"Date",?109,"Visit Dt",?118,"Date",?126,"Status"
211 . D ULINE^RCDMCUT2("=",$G(IOM))
212 ;Export to Delimited Excel format
213 I EXCEL>0 D
214 . W !,"Veteran Name",U,"SSN",U,"Claim #",U,"Claim Loc",U,"RD Chg Date",U,"RD Name",U,"Extremity",U,"RD Orig Eff Date",U,"Bill #",U,"RX Fill",U,"Oupat Visit Date",U,"Discharge Date",U,"Status"
215 Q
216 ;
Note: See TracBrowser for help on using the repository browser.