RCDMCR3A ;HEC/SBW - DMC Rated Disability Eligibility Change Report ; 22/OCT/2007
;;4.5;Accounts Receivable;**253**;Mar 20, 1995;Build 9
;;Per VHA Directive 2004-038, this routine should not be modified.
;
;This routine is being implemented for the Hold Debt to DMC Project.
;It will do the following:
; Report option in AR to assist users in focusing on reviewing the
; legitimacy of bills for veterans who are neither SC 50% to 100%
; nor in receipt of a VA Pension benefits (Veterans not included on
; the "DMC Debt Validity Report"). The report will contain
; information on veterans who have bills for episodes of care
; within the previous 365 days (or older selected date) and who
; have a new Rated Disability during a user selected time period.
;
MAIN ; Initial Interactive Processing
N STOPIT,EXCEL,RCSCR,GETBEGDT,RDDATE,RCBEGDT,RCENDDT
W !!,"*** Print the Rated Disability Eligibility Change Report ***"
;
S STOPIT=0 ; quit flag
;Prompt user for Date Range for Rated Disability Eligibility Changes
S RDDATE=$$DATE^RCDMCUT2(" Enter the Date Range for Rated Disability Changes.")
;Quit is user up arrowed or timed out
Q:RDDATE'>0
S RCBEGDT=$P(RDDATE,U,2),RCENDDT=$P(RDDATE,U,3)
;
;Prompt user for Date from which to include bills for episodes of care
;on report
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!")
;Quit if user up arrowed or timed out
Q:+GETBEGDT'>0
S BEGDT=$P(GETBEGDT,U,2)
;
; Prompt user if report will be Excel Delimited format:
S EXCEL=$$EXCEL^RCDMCUT2
;Quit is user up arrowed or timed out
Q:EXCEL="^"
D:EXCEL>0 EXMSG^RCDMCUT2
D:EXCEL'>0
. W !!,"This report may take a while to process. It is recommended that"
. W !,"you Queue this report to a device that is 132 characters wide."
;
D DEVICE^RCDMCUT2("RUN^RCDMCR3A","DMC Rated Disability Eligibility Change Report Process",.STOPIT,.RCSCR,BEGDT,EXCEL)
Q:STOPIT>0!($D(ZTQUEUED))
D RUN^RCDMCR3A
I STOPIT'=2 D PAUSE2^RCDMCUT2
Q
;
QUERPT ; Initial Taskman Scheduled Queued processing
N STOPIT,EXCEL,RCSCR,BEGDT,RCDAY,RCBEGDT,RCENDDT
S STOPIT=0,EXCEL="",RCSCR=""
;
;Get the "NUMBER OF DAYS FOR DMC REPORTS" site parameter in the AR Site
;Parameter (#342) file.
S BEGDT=$$GETRDAY^RCMSITE
;If parameter value not greater than 364 day set default to 365 days
S:BEGDT'>364 BEGDT=365
;Set report begin date to past date using Number of Days for DMC reports
S BEGDT=$$FMADD^XLFDT(DT,0-BEGDT,0,0,0)
;
;Get the # OF DAYS FOR RD ELIG CHG RPT" site parameter in the AR Site
;Parameter (#342) file.
S RCDAY=$$GETRDDAY^RCMSITE
;If parameter value not greater than zero default to 31 days
S:RCDAY'>0 RCDAY=31
;Set RD Beginning Date with RDDAY a negative value
S RCBEGDT=$$FMADD^XLFDT(DT,0-RCDAY,0,0,0)
;Set RD End Date till tomorrow to get all data for today
S RCENDDT=$$FMADD^XLFDT(DT,+1,0,0,0)
;
D RUN^RCDMCR3A
Q
;
RUN ;Get data and Print it out
;If queued ensure you delete it from the TASKS file
I $D(ZTQUEUED) S ZTREQ="@"
N RCPAGE
;If not passed date, default to get data 365 old
I $G(BEGDT)'>0 S BEGDT=$$FMADD^XLFDT(DT,-365,0,0,0)
K ^TMP($J,"RCDMCR3")
S RCPAGE=0
; Collect the data in ^TMP
D COLLECT^RCDMCR3B(.STOPIT,BEGDT,RCBEGDT,RCENDDT)
Q:$G(STOPIT)>0
U IO
; Print Report using data in ^TMP
D REPORT
I 'RCSCR W !,@IOF
D ^%ZISC
K ^TMP($J,"RCDMCR3")
K EXCEL,RCSCR,TESTDATE
Q
;
REPORT ;Print report
N RUNDATE,FULLHDR,STATUS,NAME,SSN,CHGDT,RDNAME,RDSEXTRE,BILLNO
N NAMEPRT,CHGDTPRT,RDPRT
;
S RUNDATE=$$FMTE^XLFDT($$NOW^XLFDT,"9MP")
;Print header with field headers
S FULLHDR=1
D HDR
I +$D(^TMP($J,"RCDMCR3"))'>0 W !,"No data meets the criteria." Q
S NAME=""
F S NAME=$O(^TMP($J,"RCDMCR3","DETAIL",NAME)) Q:NAME']"" D Q:STOPIT
. S SSN=""
. F S SSN=$O(^TMP($J,"RCDMCR3","DETAIL",NAME,SSN)) Q:SSN']"" D Q:STOPIT
. . ;NAMEPRT - Use to only print Name & SSN once for multiple Vet RDs
. . S NAMEPRT=1
. . S CHGDT=0
. . F S CHGDT=$O(^TMP($J,"RCDMCR3","DETAIL",NAME,SSN,CHGDT)) Q:CHGDT'>0 D Q:STOPIT
. . . ;CHGDTPRT - Use to only print RD Change Date once for multiple
. . . ; RD Change Dates
. . . S CHGDTPRT=1
. . . S RDNAME=""
. . . F S RDNAME=$O(^TMP($J,"RCDMCR3","DETAIL",NAME,SSN,CHGDT,RDNAME)) Q:RDNAME']"" D Q:STOPIT
. . . . S RDSEXTRE=""
. . . . F S RDSEXTRE=$O(^TMP($J,"RCDMCR3","DETAIL",NAME,SSN,CHGDT,RDNAME,RDSEXTRE)) Q:RDSEXTRE']"" D Q:STOPIT
. . . . . ;CHGDTPRT - Use to only print RD Name once for multiple RD Names
. . . . . S RDPRT=1
. . . . . S BILLNO=""
. . . . . F S BILLNO=$O(^TMP($J,"RCDMCR3","DETAIL",NAME,SSN,CHGDT,RDNAME,RDSEXTRE,BILLNO)) Q:BILLNO']"" D Q:STOPIT
. . . . . . N NODE,CNUM,CLOC,RDLEXTRE,RDORGDT,RXDT,OPTDT,DISCHDT
. . . . . . N STATUS
. . . . . . S NODE=$G(^TMP($J,"RCDMCR3","DETAIL",NAME,SSN,CHGDT,RDNAME,RDSEXTRE,BILLNO))
. . . . . . S CNUM=$P(NODE,U,1),CLOC=$P(NODE,U,2)
. . . . . . S RDLEXTRE=$P(NODE,U,3)
. . . . . . S RDORGDT=$P(NODE,U,4)
. . . . . . S RXDT=$P(NODE,U,5),OPTDT=$P(NODE,U,6)
. . . . . . S DISCHDT=$P(NODE,U,7)
. . . . . . S STATUS=$P(NODE,U,8)
. . . . . . I EXCEL'>0 D WRLINE Q
. . . . . . I EXCEL>0 D WRLINE2 Q
;Don't print summary if user ^ out
Q:STOPIT
;Don't print field headers
S FULLHDR=0
;Ensure Summary data all fits on same page
D CHKP(9) Q:STOPIT
W !!,"SUMMARY"
D ULINE^RCDMCUT2("=",48)
W !,"Total Number of unique veterans: ",$J($FN($G(^TMP($J,"RCDMCR3","SUM-VET")),",P"),13)
W !,"Total Number of Rated Disabilities: ",$J($FN($G(^TMP($J,"RCDMCR3","SUM-RD")),",P"),13)
W !,"Total Number of Bills: ",$J($FN($G(^TMP($J,"RCDMCR3","SUM-BILL")),",P"),13)
;
Q
;
WRLINE ; Write the data formated report line
D CHKP() Q:STOPIT
;If Multiple Bills for Vet only print Name & SSN for 1st record on page
W !
I NAMEPRT>0 D
. W $E(NAME,1,14)
. W ?15,SSN
. W ?21,CNUM
. W ?32,CLOC
. S NAMEPRT=0
I CHGDTPRT>0 D
. W ?38,$$STRIP^XLFSTR($$FMTE^XLFDT(CHGDT,"8D")," ")
. S CHGDTPRT=0
I RDPRT>0 D
. W ?46,$E(RDNAME,1,29)
. W ?77,RDSEXTRE
. W ?81,$$STRIP^XLFSTR($$FMTE^XLFDT(RDORGDT,"8D")," ")
. S RDPRT=0
W ?89,BILLNO
W ?101,$$STRIP^XLFSTR($$FMTE^XLFDT(RXDT,"8D")," ")
W ?109,$$STRIP^XLFSTR($$FMTE^XLFDT(OPTDT,"8D")," ")
W ?118,$$STRIP^XLFSTR($$FMTE^XLFDT(DISCHDT,"8D")," ")
W ?126,$E(STATUS,1,6)
Q
;
WRLINE2 ; Write the Excel report line
W !
W NAME_U
W SSN_U
W CNUM_U
W CLOC_U
W $$FMTE^XLFDT(CHGDT,"9D")_U
W RDNAME_U
W RDLEXTRE_U
W $$FMTE^XLFDT(RDORGDT,"9D")_U
W BILLNO_U
W $$FMTE^XLFDT(RXDT,"9D")_U
W $$FMTE^XLFDT(OPTDT,"9D")_U
W $$FMTE^XLFDT(DISCHDT,"9D")_U
W STATUS_U
Q
;
CHKP(FOOTER) ;Check for End of Page
;INPUT:
; FOOTER - Footer value. Optional. Default to 4 if nothing passed
I $G(FOOTER)'>0 S FOOTER=4
I $Y>(IOSL-FOOTER) D:RCSCR PAUSE^RCDMCUT2 Q:STOPIT D HDR
Q
;
HDR ;Print Report Header
;NAMEPRT - Use to print Name & SSN once for multiple Vets RDs per page
;CHGDTPRT - Use to print RD Change Date once for multiple RDs per page
;RDPRT - Use to print RD Name once for multiple RD names per page
S NAMEPRT=1,CHGDTPRT=1,RDPRT=1
S RCPAGE=RCPAGE+1
W @IOF,"Rated Disability Eligibility Change Report -- Run Date: ",RUNDATE
W " -- Episode of Care Data from ",$$FMTE^XLFDT(BEGDT,"9D")
W ?122,"Page: "_RCPAGE
W !?5,"RD Change Dates from ",$$FMTE^XLFDT(RCBEGDT,"9D")," to ",$$FMTE^XLFDT(RCENDDT,"9D")
;Quit if printing summary data. Don't need field headers
I FULLHDR'>0 D ULINE^RCDMCUT2("=",$G(IOM)) Q
;Print to screen or printer
I EXCEL'>0 D
. W !?21,"Claim",?32,"Claim",?38,"RD Chg",?74,"Extre-",?81,"RD Orig",?89,"BILL",?101,"RX Fill",?109,"Outpat",?118,"Dischar"
. 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"
. D ULINE^RCDMCUT2("=",$G(IOM))
;Export to Delimited Excel format
I EXCEL>0 D
. 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"
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDMCR3A 8367 printed Apr 09, 2024@20:52:44 Page 2
RCDMCR3A ;HEC/SBW - DMC Rated Disability Eligibility Change Report ; 22/OCT/2007
+1 ;;4.5;Accounts Receivable;**253**;Mar 20, 1995;Build 9
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;This routine is being implemented for the Hold Debt to DMC Project.
+5 ;It will do the following:
+6 ; Report option in AR to assist users in focusing on reviewing the
+7 ; legitimacy of bills for veterans who are neither SC 50% to 100%
+8 ; nor in receipt of a VA Pension benefits (Veterans not included on
+9 ; the "DMC Debt Validity Report"). The report will contain
+10 ; information on veterans who have bills for episodes of care
+11 ; within the previous 365 days (or older selected date) and who
+12 ; have a new Rated Disability during a user selected time period.
+13 ;
MAIN ; Initial Interactive Processing
+1 NEW STOPIT,EXCEL,RCSCR,GETBEGDT,RDDATE,RCBEGDT,RCENDDT
+2 WRITE !!,"*** Print the Rated Disability Eligibility Change Report ***"
+3 ;
+4 ; quit flag
SET STOPIT=0
+5 ;Prompt user for Date Range for Rated Disability Eligibility Changes
+6 SET RDDATE=$$DATE^RCDMCUT2(" Enter the Date Range for Rated Disability Changes.")
+7 ;Quit is user up arrowed or timed out
+8 if RDDATE'>0
QUIT
+9 SET RCBEGDT=$PIECE(RDDATE,U,2)
SET RCENDDT=$PIECE(RDDATE,U,3)
+10 ;
+11 ;Prompt user for Date from which to include bills for episodes of care
+12 ;on report
+13 SET 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!")
+14 ;Quit if user up arrowed or timed out
+15 if +GETBEGDT'>0
QUIT
+16 SET BEGDT=$PIECE(GETBEGDT,U,2)
+17 ;
+18 ; Prompt user if report will be Excel Delimited format:
+19 SET EXCEL=$$EXCEL^RCDMCUT2
+20 ;Quit is user up arrowed or timed out
+21 if EXCEL="^"
QUIT
+22 if EXCEL>0
DO EXMSG^RCDMCUT2
+23 if EXCEL'>0
Begin DoDot:1
+24 WRITE !!,"This report may take a while to process. It is recommended that"
+25 WRITE !,"you Queue this report to a device that is 132 characters wide."
End DoDot:1
+26 ;
+27 DO DEVICE^RCDMCUT2("RUN^RCDMCR3A","DMC Rated Disability Eligibility Change Report Process",.STOPIT,.RCSCR,BEGDT,EXCEL)
+28 if STOPIT>0!($DATA(ZTQUEUED))
QUIT
+29 DO RUN^RCDMCR3A
+30 IF STOPIT'=2
DO PAUSE2^RCDMCUT2
+31 QUIT
+32 ;
QUERPT ; Initial Taskman Scheduled Queued processing
+1 NEW STOPIT,EXCEL,RCSCR,BEGDT,RCDAY,RCBEGDT,RCENDDT
+2 SET STOPIT=0
SET EXCEL=""
SET RCSCR=""
+3 ;
+4 ;Get the "NUMBER OF DAYS FOR DMC REPORTS" site parameter in the AR Site
+5 ;Parameter (#342) file.
+6 SET BEGDT=$$GETRDAY^RCMSITE
+7 ;If parameter value not greater than 364 day set default to 365 days
+8 if BEGDT'>364
SET BEGDT=365
+9 ;Set report begin date to past date using Number of Days for DMC reports
+10 SET BEGDT=$$FMADD^XLFDT(DT,0-BEGDT,0,0,0)
+11 ;
+12 ;Get the # OF DAYS FOR RD ELIG CHG RPT" site parameter in the AR Site
+13 ;Parameter (#342) file.
+14 SET RCDAY=$$GETRDDAY^RCMSITE
+15 ;If parameter value not greater than zero default to 31 days
+16 if RCDAY'>0
SET RCDAY=31
+17 ;Set RD Beginning Date with RDDAY a negative value
+18 SET RCBEGDT=$$FMADD^XLFDT(DT,0-RCDAY,0,0,0)
+19 ;Set RD End Date till tomorrow to get all data for today
+20 SET RCENDDT=$$FMADD^XLFDT(DT,+1,0,0,0)
+21 ;
+22 DO RUN^RCDMCR3A
+23 QUIT
+24 ;
RUN ;Get data and Print it out
+1 ;If queued ensure you delete it from the TASKS file
+2 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 NEW RCPAGE
+4 ;If not passed date, default to get data 365 old
+5 IF $GET(BEGDT)'>0
SET BEGDT=$$FMADD^XLFDT(DT,-365,0,0,0)
+6 KILL ^TMP($JOB,"RCDMCR3")
+7 SET RCPAGE=0
+8 ; Collect the data in ^TMP
+9 DO COLLECT^RCDMCR3B(.STOPIT,BEGDT,RCBEGDT,RCENDDT)
+10 if $GET(STOPIT)>0
QUIT
+11 USE IO
+12 ; Print Report using data in ^TMP
+13 DO REPORT
+14 IF 'RCSCR
WRITE !,@IOF
+15 DO ^%ZISC
+16 KILL ^TMP($JOB,"RCDMCR3")
+17 KILL EXCEL,RCSCR,TESTDATE
+18 QUIT
+19 ;
REPORT ;Print report
+1 NEW RUNDATE,FULLHDR,STATUS,NAME,SSN,CHGDT,RDNAME,RDSEXTRE,BILLNO
+2 NEW NAMEPRT,CHGDTPRT,RDPRT
+3 ;
+4 SET RUNDATE=$$FMTE^XLFDT($$NOW^XLFDT,"9MP")
+5 ;Print header with field headers
+6 SET FULLHDR=1
+7 DO HDR
+8 IF +$DATA(^TMP($JOB,"RCDMCR3"))'>0
WRITE !,"No data meets the criteria."
QUIT
+9 SET NAME=""
+10 FOR
SET NAME=$ORDER(^TMP($JOB,"RCDMCR3","DETAIL",NAME))
if NAME']""
QUIT
Begin DoDot:1
+11 SET SSN=""
+12 FOR
SET SSN=$ORDER(^TMP($JOB,"RCDMCR3","DETAIL",NAME,SSN))
if SSN']""
QUIT
Begin DoDot:2
+13 ;NAMEPRT - Use to only print Name & SSN once for multiple Vet RDs
+14 SET NAMEPRT=1
+15 SET CHGDT=0
+16 FOR
SET CHGDT=$ORDER(^TMP($JOB,"RCDMCR3","DETAIL",NAME,SSN,CHGDT))
if CHGDT'>0
QUIT
Begin DoDot:3
+17 ;CHGDTPRT - Use to only print RD Change Date once for multiple
+18 ; RD Change Dates
+19 SET CHGDTPRT=1
+20 SET RDNAME=""
+21 FOR
SET RDNAME=$ORDER(^TMP($JOB,"RCDMCR3","DETAIL",NAME,SSN,CHGDT,RDNAME))
if RDNAME']""
QUIT
Begin DoDot:4
+22 SET RDSEXTRE=""
+23 FOR
SET RDSEXTRE=$ORDER(^TMP($JOB,"RCDMCR3","DETAIL",NAME,SSN,CHGDT,RDNAME,RDSEXTRE))
if RDSEXTRE']""
QUIT
Begin DoDot:5
+24 ;CHGDTPRT - Use to only print RD Name once for multiple RD Names
+25 SET RDPRT=1
+26 SET BILLNO=""
+27 FOR
SET BILLNO=$ORDER(^TMP($JOB,"RCDMCR3","DETAIL",NAME,SSN,CHGDT,RDNAME,RDSEXTRE,BILLNO))
if BILLNO']""
QUIT
Begin DoDot:6
+28 NEW NODE,CNUM,CLOC,RDLEXTRE,RDORGDT,RXDT,OPTDT,DISCHDT
+29 NEW STATUS
+30 SET NODE=$GET(^TMP($JOB,"RCDMCR3","DETAIL",NAME,SSN,CHGDT,RDNAME,RDSEXTRE,BILLNO))
+31 SET CNUM=$PIECE(NODE,U,1)
SET CLOC=$PIECE(NODE,U,2)
+32 SET RDLEXTRE=$PIECE(NODE,U,3)
+33 SET RDORGDT=$PIECE(NODE,U,4)
+34 SET RXDT=$PIECE(NODE,U,5)
SET OPTDT=$PIECE(NODE,U,6)
+35 SET DISCHDT=$PIECE(NODE,U,7)
+36 SET STATUS=$PIECE(NODE,U,8)
+37 IF EXCEL'>0
DO WRLINE
QUIT
+38 IF EXCEL>0
DO WRLINE2
QUIT
End DoDot:6
if STOPIT
QUIT
End DoDot:5
if STOPIT
QUIT
End DoDot:4
if STOPIT
QUIT
End DoDot:3
if STOPIT
QUIT
End DoDot:2
if STOPIT
QUIT
End DoDot:1
if STOPIT
QUIT
+39 ;Don't print summary if user ^ out
+40 if STOPIT
QUIT
+41 ;Don't print field headers
+42 SET FULLHDR=0
+43 ;Ensure Summary data all fits on same page
+44 DO CHKP(9)
if STOPIT
QUIT
+45 WRITE !!,"SUMMARY"
+46 DO ULINE^RCDMCUT2("=",48)
+47 WRITE !,"Total Number of unique veterans: ",$JUSTIFY($FNUMBER($GET(^TMP($JOB,"RCDMCR3","SUM-VET")),",P"),13)
+48 WRITE !,"Total Number of Rated Disabilities: ",$JUSTIFY($FNUMBER($GET(^TMP($JOB,"RCDMCR3","SUM-RD")),",P"),13)
+49 WRITE !,"Total Number of Bills: ",$JUSTIFY($FNUMBER($GET(^TMP($JOB,"RCDMCR3","SUM-BILL")),",P"),13)
+50 ;
+51 QUIT
+52 ;
WRLINE ; Write the data formated report line
+1 DO CHKP()
if STOPIT
QUIT
+2 ;If Multiple Bills for Vet only print Name & SSN for 1st record on page
+3 WRITE !
+4 IF NAMEPRT>0
Begin DoDot:1
+5 WRITE $EXTRACT(NAME,1,14)
+6 WRITE ?15,SSN
+7 WRITE ?21,CNUM
+8 WRITE ?32,CLOC
+9 SET NAMEPRT=0
End DoDot:1
+10 IF CHGDTPRT>0
Begin DoDot:1
+11 WRITE ?38,$$STRIP^XLFSTR($$FMTE^XLFDT(CHGDT,"8D")," ")
+12 SET CHGDTPRT=0
End DoDot:1
+13 IF RDPRT>0
Begin DoDot:1
+14 WRITE ?46,$EXTRACT(RDNAME,1,29)
+15 WRITE ?77,RDSEXTRE
+16 WRITE ?81,$$STRIP^XLFSTR($$FMTE^XLFDT(RDORGDT,"8D")," ")
+17 SET RDPRT=0
End DoDot:1
+18 WRITE ?89,BILLNO
+19 WRITE ?101,$$STRIP^XLFSTR($$FMTE^XLFDT(RXDT,"8D")," ")
+20 WRITE ?109,$$STRIP^XLFSTR($$FMTE^XLFDT(OPTDT,"8D")," ")
+21 WRITE ?118,$$STRIP^XLFSTR($$FMTE^XLFDT(DISCHDT,"8D")," ")
+22 WRITE ?126,$EXTRACT(STATUS,1,6)
+23 QUIT
+24 ;
WRLINE2 ; Write the Excel report line
+1 WRITE !
+2 WRITE NAME_U
+3 WRITE SSN_U
+4 WRITE CNUM_U
+5 WRITE CLOC_U
+6 WRITE $$FMTE^XLFDT(CHGDT,"9D")_U
+7 WRITE RDNAME_U
+8 WRITE RDLEXTRE_U
+9 WRITE $$FMTE^XLFDT(RDORGDT,"9D")_U
+10 WRITE BILLNO_U
+11 WRITE $$FMTE^XLFDT(RXDT,"9D")_U
+12 WRITE $$FMTE^XLFDT(OPTDT,"9D")_U
+13 WRITE $$FMTE^XLFDT(DISCHDT,"9D")_U
+14 WRITE STATUS_U
+15 QUIT
+16 ;
CHKP(FOOTER) ;Check for End of Page
+1 ;INPUT:
+2 ; FOOTER - Footer value. Optional. Default to 4 if nothing passed
+3 IF $GET(FOOTER)'>0
SET FOOTER=4
+4 IF $Y>(IOSL-FOOTER)
if RCSCR
DO PAUSE^RCDMCUT2
if STOPIT
QUIT
DO HDR
+5 QUIT
+6 ;
HDR ;Print Report Header
+1 ;NAMEPRT - Use to print Name & SSN once for multiple Vets RDs per page
+2 ;CHGDTPRT - Use to print RD Change Date once for multiple RDs per page
+3 ;RDPRT - Use to print RD Name once for multiple RD names per page
+4 SET NAMEPRT=1
SET CHGDTPRT=1
SET RDPRT=1
+5 SET RCPAGE=RCPAGE+1
+6 WRITE @IOF,"Rated Disability Eligibility Change Report -- Run Date: ",RUNDATE
+7 WRITE " -- Episode of Care Data from ",$$FMTE^XLFDT(BEGDT,"9D")
+8 WRITE ?122,"Page: "_RCPAGE
+9 WRITE !?5,"RD Change Dates from ",$$FMTE^XLFDT(RCBEGDT,"9D")," to ",$$FMTE^XLFDT(RCENDDT,"9D")
+10 ;Quit if printing summary data. Don't need field headers
+11 IF FULLHDR'>0
DO ULINE^RCDMCUT2("=",$GET(IOM))
QUIT
+12 ;Print to screen or printer
+13 IF EXCEL'>0
Begin DoDot:1
+14 WRITE !?21,"Claim",?32,"Claim",?38,"RD Chg",?74,"Extre-",?81,"RD Orig",?89,"BILL",?101,"RX Fill",?109,"Outpat",?118,"Dischar"
+15 WRITE !,"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"
+16 DO ULINE^RCDMCUT2("=",$GET(IOM))
End DoDot:1
+17 ;Export to Delimited Excel format
+18 IF EXCEL>0
Begin DoDot:1
+19 WRITE !,"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"
End DoDot:1
+20 QUIT
+21 ;
