| 1 | RCDMCR3A ;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 | ;
|
|---|
| 15 | MAIN ; 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 | ;
|
|---|
| 48 | QUERPT ; 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 | ;
|
|---|
| 73 | RUN ;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 | ;
|
|---|
| 93 | REPORT ;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 | ;
|
|---|
| 146 | WRLINE ; 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 | ;
|
|---|
| 171 | WRLINE2 ; 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 | ;
|
|---|
| 188 | CHKP(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 | ;
|
|---|
| 195 | HDR ;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 | ;
|
|---|
