RCDMCR1A ;HEC/SBW - DMC Debt Validity Report ;28/SEP/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 SC 50% to 100% or in
; receipt of VA Pension benefits. The report contains information
; on veterans who meet the above criteria and have bills for episodes
; of care within the previous 365 days (or older selected date) with
; a DMC Debt Valid field not flagged as 'YES' or 'NO'. Authorized
; billing staff can run the report to ensure that all bills meeting
; the above criteria are reviewed and if necessary the appropriate
; action is taken as follows:
; Bill is appropriate - Update the Debt Validity Status field to
; 'YES' in order that the bill is referred to DMC via the
; automated process if all other DMC criteria is met
; Bill is inappropriate - Update the Debt Validity Status Field
; to 'NO' and staff will cancel the bill using existing
; functionality
; Inappropriate bill sent to DMC - Staff to initiate action to
; cancel DMC collection or refund payments using existing
; functionality
;
MAIN ; Initial Interactive Processing
N STOPIT,GETBEGDT,BEGDT,EXCEL,RCSCR
W !!,"*** Print the Debt Validity Report ***"
;
S STOPIT=0 ; quit flag
; Prompts to the user:
;
;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!")
Q:+GETBEGDT'>0
S BEGDT=$P(GETBEGDT,U,2)
;
S EXCEL=$$EXCEL^RCDMCUT2()
;Quit if 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^RCDMCR1A","DMC Debt Validity Report Process",.STOPIT,.RCSCR,BEGDT,EXCEL)
Q:STOPIT>0!($D(ZTQUEUED))
D RUN^RCDMCR1A
I STOPIT'=2 D PAUSE2^RCDMCUT2
Q
;
QUERPT ; Initial Taskman Scheduled Queued processing
N STOPIT,EXCEL,RCSCR,BEGDT
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)
;
D RUN^RCDMCR1A
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,"RCDMCR1")
S RCPAGE=0
; Collect the data in ^TMP
D COLLECT^RCDMCR1B(.STOPIT,BEGDT)
Q:$G(STOPIT)>0
U IO
; Print Report using data in ^TMP
D REPORT
I 'RCSCR W !,@IOF
D ^%ZISC
K ^TMP($J,"RCDMCR1")
K EXCEL,RCSCR,TESTDATE
Q
;
REPORT ;Print report
N RUNDATE,FULLHDR,STATUS,IEN,NAME,SSN,NAMEPRT,BILLNO,NODE
N CNUM,CLOC,ELIG,ELIGDT,RXDT,OPTDT,DISCHDT,DMCREFDT,DMCVALID
S RUNDATE=$$FMTE^XLFDT($$NOW^XLFDT,"9MP")
;Print header with field headers
S FULLHDR=1
D HDR
I +$D(^TMP($J,"RCDMCR1"))'>0 W !,"No data meets the criteria." Q
S NAME=""
F S NAME=$O(^TMP($J,"RCDMCR1","DETAIL",NAME)) Q:NAME']"" D Q:STOPIT
. S SSN=""
. F S SSN=$O(^TMP($J,"RCDMCR1","DETAIL",NAME,SSN)) Q:SSN']"" D Q:STOPIT
. . ;NAMEPRT - Use to only print Name & SSN once for multiple bills
. . S NAMEPRT=1
. . S BILLNO=""
. . F S BILLNO=$O(^TMP($J,"RCDMCR1","DETAIL",NAME,SSN,BILLNO)) Q:BILLNO']"" D Q:STOPIT
. . . S NODE=$G(^TMP($J,"RCDMCR1","DETAIL",NAME,SSN,BILLNO))
. . . S CNUM=$P(NODE,U,1),CLOC=$P(NODE,U,2),ELIG=$P(NODE,U,3)
. . . S ELIGDT=$P(NODE,U,4),RXDT=$P(NODE,U,5),OPTDT=$P(NODE,U,6)
. . . S DISCHDT=$P(NODE,U,7),DMCREFDT=$P(NODE,U,8),DMCVALID=$P(NODE,U,9)
. . . S STATUS=$P(NODE,U,10)
. . . 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 all Summary data fits on page
D CHKP(9) Q:STOPIT
W !!,"SUMMARY - BILLS REFERRED TO DMC"
D ULINE^RCDMCUT2("-",55)
W !,"Total Number of Bills Referred: ",$J($FN($G(^TMP($J,"RCDMCR1","SUM-BILL")),",P"),13)
W !,"Total Number of unique veterans referred: ",$J($FN($G(^TMP($J,"RCDMCR1","SUM-VET")),",P"),13)
W !,"Total Account Receivable Dollars referred: ",$J("$"_$FN($G(^TMP($J,"RCDMCR1","SUM-$")),",P"),13)
;Ensure all Summary data fits on page
D CHKP(9) Q:STOPIT
W !!,"SUMMARY - TOTAL BILLS"
D ULINE^RCDMCUT2("-",46)
W !,"Total Number of Bills: ",$J($FN($G(^TMP($J,"RCDMCR1","TOT-BILL")),",P"),13)
W !,"Total Number of unique veterans: ",$J($FN($G(^TMP($J,"RCDMCR1","TOT-VET")),",P"),13)
W !,"Total Account Receivable Dollars: ",$J("$"_$FN($G(^TMP($J,"RCDMCR1","TOT-$")),",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,16)
. W ?18,SSN
. W ?25,CNUM
. W ?37,CLOC
. W ?44,ELIG
. Q:ELIGDT>0
. S NAMEPRT=0
W ?60,BILLNO
W ?73,$$STRIP^XLFSTR($$FMTE^XLFDT(RXDT,"8D")," ")
W ?83,$$STRIP^XLFSTR($$FMTE^XLFDT(OPTDT,"8D")," ")
W ?92,$$STRIP^XLFSTR($$FMTE^XLFDT(DISCHDT,"8D")," ")
W ?101,DMCVALID
W ?110,$E(STATUS,1,9)
W ?121,$$STRIP^XLFSTR($$FMTE^XLFDT(DMCREFDT,"8D")," ")
I NAMEPRT>0,ELIGDT>0 W !?44,$$STRIP^XLFSTR($$FMTE^XLFDT(ELIGDT,"8D")," ") S NAMEPRT=0
Q
;
WRLINE2 ; Write the Excel report line
W !
W NAME_U
W SSN_U
W CNUM_U
W CLOC_U
W ELIG_U
W $$FMTE^XLFDT(ELIGDT,"9D")_U
W BILLNO_U
W $$FMTE^XLFDT(RXDT,"9D")_U
W $$FMTE^XLFDT(OPTDT,"9D")_U
W $$FMTE^XLFDT(DISCHDT,"9D")_U
W DMCVALID_U
W STATUS_U
W $$FMTE^XLFDT(DMCREFDT,"9D")
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 only print Name & SSN once for multiple bills
S NAMEPRT=1
S RCPAGE=RCPAGE+1
W @IOF,"DMC Debt Validity Report"
W ?40,"Run Date: ",RUNDATE
W ?72,"Episode of Care Data from ",$$FMTE^XLFDT(BEGDT,"9D")
W ?115,"Page: "_RCPAGE
;If summary data print underline and quit. Don't need field headers.
I FULLHDR'>0 D ULINE^RCDMCUT2("=",$G(IOM)) Q
;Print to screen or printer
I EXCEL'>0 D
. W !!?25,"Claim",?37,"Claim",?44,"Eligibility/",?60,"Bill",?73,"RX Fill/",?83,"Outpat",?92,"Dischar",?101,"DMC Debt",?121,"DMC Ref"
. 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"
. 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,"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"
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDMCR1A 7606 printed Apr 09, 2024@20:46:40 Page 2
RCDMCR1A ;HEC/SBW - DMC Debt Validity Report ;28/SEP/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 SC 50% to 100% or in
+8 ; receipt of VA Pension benefits. The report contains information
+9 ; on veterans who meet the above criteria and have bills for episodes
+10 ; of care within the previous 365 days (or older selected date) with
+11 ; a DMC Debt Valid field not flagged as 'YES' or 'NO'. Authorized
+12 ; billing staff can run the report to ensure that all bills meeting
+13 ; the above criteria are reviewed and if necessary the appropriate
+14 ; action is taken as follows:
+15 ; Bill is appropriate - Update the Debt Validity Status field to
+16 ; 'YES' in order that the bill is referred to DMC via the
+17 ; automated process if all other DMC criteria is met
+18 ; Bill is inappropriate - Update the Debt Validity Status Field
+19 ; to 'NO' and staff will cancel the bill using existing
+20 ; functionality
+21 ; Inappropriate bill sent to DMC - Staff to initiate action to
+22 ; cancel DMC collection or refund payments using existing
+23 ; functionality
+24 ;
MAIN ; Initial Interactive Processing
+1 NEW STOPIT,GETBEGDT,BEGDT,EXCEL,RCSCR
+2 WRITE !!,"*** Print the Debt Validity Report ***"
+3 ;
+4 ; quit flag
SET STOPIT=0
+5 ; Prompts to the user:
+6 ;
+7 ;Prompt user for Date from which to include bills for episodes of care
+8 ;on report
+9 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!")
+10 if +GETBEGDT'>0
QUIT
+11 SET BEGDT=$PIECE(GETBEGDT,U,2)
+12 ;
+13 SET EXCEL=$$EXCEL^RCDMCUT2()
+14 ;Quit if user Up Arrowed or Timed Out
+15 if EXCEL="^"
QUIT
+16 if EXCEL>0
DO EXMSG^RCDMCUT2
+17 if EXCEL'>0
Begin DoDot:1
+18 WRITE !!,"This report may take a while to process. It is recommended that"
+19 WRITE !,"you Queue this report to a device that is 132 characters wide."
End DoDot:1
+20 ;
+21 DO DEVICE^RCDMCUT2("RUN^RCDMCR1A","DMC Debt Validity Report Process",.STOPIT,.RCSCR,BEGDT,EXCEL)
+22 if STOPIT>0!($DATA(ZTQUEUED))
QUIT
+23 DO RUN^RCDMCR1A
+24 IF STOPIT'=2
DO PAUSE2^RCDMCUT2
+25 QUIT
+26 ;
QUERPT ; Initial Taskman Scheduled Queued processing
+1 NEW STOPIT,EXCEL,RCSCR,BEGDT
+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 DO RUN^RCDMCR1A
+13 QUIT
+14 ;
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,"RCDMCR1")
+7 SET RCPAGE=0
+8 ; Collect the data in ^TMP
+9 DO COLLECT^RCDMCR1B(.STOPIT,BEGDT)
+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,"RCDMCR1")
+17 KILL EXCEL,RCSCR,TESTDATE
+18 QUIT
+19 ;
REPORT ;Print report
+1 NEW RUNDATE,FULLHDR,STATUS,IEN,NAME,SSN,NAMEPRT,BILLNO,NODE
+2 NEW CNUM,CLOC,ELIG,ELIGDT,RXDT,OPTDT,DISCHDT,DMCREFDT,DMCVALID
+3 SET RUNDATE=$$FMTE^XLFDT($$NOW^XLFDT,"9MP")
+4 ;Print header with field headers
+5 SET FULLHDR=1
+6 DO HDR
+7 IF +$DATA(^TMP($JOB,"RCDMCR1"))'>0
WRITE !,"No data meets the criteria."
QUIT
+8 SET NAME=""
+9 FOR
SET NAME=$ORDER(^TMP($JOB,"RCDMCR1","DETAIL",NAME))
if NAME']""
QUIT
Begin DoDot:1
+10 SET SSN=""
+11 FOR
SET SSN=$ORDER(^TMP($JOB,"RCDMCR1","DETAIL",NAME,SSN))
if SSN']""
QUIT
Begin DoDot:2
+12 ;NAMEPRT - Use to only print Name & SSN once for multiple bills
+13 SET NAMEPRT=1
+14 SET BILLNO=""
+15 FOR
SET BILLNO=$ORDER(^TMP($JOB,"RCDMCR1","DETAIL",NAME,SSN,BILLNO))
if BILLNO']""
QUIT
Begin DoDot:3
+16 SET NODE=$GET(^TMP($JOB,"RCDMCR1","DETAIL",NAME,SSN,BILLNO))
+17 SET CNUM=$PIECE(NODE,U,1)
SET CLOC=$PIECE(NODE,U,2)
SET ELIG=$PIECE(NODE,U,3)
+18 SET ELIGDT=$PIECE(NODE,U,4)
SET RXDT=$PIECE(NODE,U,5)
SET OPTDT=$PIECE(NODE,U,6)
+19 SET DISCHDT=$PIECE(NODE,U,7)
SET DMCREFDT=$PIECE(NODE,U,8)
SET DMCVALID=$PIECE(NODE,U,9)
+20 SET STATUS=$PIECE(NODE,U,10)
+21 IF EXCEL'>0
DO WRLINE
QUIT
+22 IF EXCEL>0
DO WRLINE2
QUIT
End DoDot:3
if STOPIT
QUIT
End DoDot:2
if STOPIT
QUIT
End DoDot:1
if STOPIT
QUIT
+23 ;Don't print summary if user ^ out
+24 if STOPIT
QUIT
+25 ;Don't print field headers
+26 SET FULLHDR=0
+27 ;Ensure all Summary data fits on page
+28 DO CHKP(9)
if STOPIT
QUIT
+29 WRITE !!,"SUMMARY - BILLS REFERRED TO DMC"
+30 DO ULINE^RCDMCUT2("-",55)
+31 WRITE !,"Total Number of Bills Referred: ",$JUSTIFY($FNUMBER($GET(^TMP($JOB,"RCDMCR1","SUM-BILL")),",P"),13)
+32 WRITE !,"Total Number of unique veterans referred: ",$JUSTIFY($FNUMBER($GET(^TMP($JOB,"RCDMCR1","SUM-VET")),",P"),13)
+33 WRITE !,"Total Account Receivable Dollars referred: ",$JUSTIFY("$"_$FNUMBER($GET(^TMP($JOB,"RCDMCR1","SUM-$")),",P"),13)
+34 ;Ensure all Summary data fits on page
+35 DO CHKP(9)
if STOPIT
QUIT
+36 WRITE !!,"SUMMARY - TOTAL BILLS"
+37 DO ULINE^RCDMCUT2("-",46)
+38 WRITE !,"Total Number of Bills: ",$JUSTIFY($FNUMBER($GET(^TMP($JOB,"RCDMCR1","TOT-BILL")),",P"),13)
+39 WRITE !,"Total Number of unique veterans: ",$JUSTIFY($FNUMBER($GET(^TMP($JOB,"RCDMCR1","TOT-VET")),",P"),13)
+40 WRITE !,"Total Account Receivable Dollars: ",$JUSTIFY("$"_$FNUMBER($GET(^TMP($JOB,"RCDMCR1","TOT-$")),",P"),13)
+41 ;
+42 QUIT
+43 ;
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,16)
+6 WRITE ?18,SSN
+7 WRITE ?25,CNUM
+8 WRITE ?37,CLOC
+9 WRITE ?44,ELIG
+10 if ELIGDT>0
QUIT
+11 SET NAMEPRT=0
End DoDot:1
+12 WRITE ?60,BILLNO
+13 WRITE ?73,$$STRIP^XLFSTR($$FMTE^XLFDT(RXDT,"8D")," ")
+14 WRITE ?83,$$STRIP^XLFSTR($$FMTE^XLFDT(OPTDT,"8D")," ")
+15 WRITE ?92,$$STRIP^XLFSTR($$FMTE^XLFDT(DISCHDT,"8D")," ")
+16 WRITE ?101,DMCVALID
+17 WRITE ?110,$EXTRACT(STATUS,1,9)
+18 WRITE ?121,$$STRIP^XLFSTR($$FMTE^XLFDT(DMCREFDT,"8D")," ")
+19 IF NAMEPRT>0
IF ELIGDT>0
WRITE !?44,$$STRIP^XLFSTR($$FMTE^XLFDT(ELIGDT,"8D")," ")
SET NAMEPRT=0
+20 QUIT
+21 ;
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 ELIG_U
+7 WRITE $$FMTE^XLFDT(ELIGDT,"9D")_U
+8 WRITE BILLNO_U
+9 WRITE $$FMTE^XLFDT(RXDT,"9D")_U
+10 WRITE $$FMTE^XLFDT(OPTDT,"9D")_U
+11 WRITE $$FMTE^XLFDT(DISCHDT,"9D")_U
+12 WRITE DMCVALID_U
+13 WRITE STATUS_U
+14 WRITE $$FMTE^XLFDT(DMCREFDT,"9D")
+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 only print Name & SSN once for multiple bills
+2 SET NAMEPRT=1
+3 SET RCPAGE=RCPAGE+1
+4 WRITE @IOF,"DMC Debt Validity Report"
+5 WRITE ?40,"Run Date: ",RUNDATE
+6 WRITE ?72,"Episode of Care Data from ",$$FMTE^XLFDT(BEGDT,"9D")
+7 WRITE ?115,"Page: "_RCPAGE
+8 ;If summary data print underline and quit. Don't need field headers.
+9 IF FULLHDR'>0
DO ULINE^RCDMCUT2("=",$GET(IOM))
QUIT
+10 ;Print to screen or printer
+11 IF EXCEL'>0
Begin DoDot:1
+12 WRITE !!?25,"Claim",?37,"Claim",?44,"Eligibility/",?60,"Bill",?73,"RX Fill/",?83,"Outpat",?92,"Dischar",?101,"DMC Debt",?121,"DMC Ref"
+13 WRITE !,"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"
+14 DO ULINE^RCDMCUT2("=",$GET(IOM))
End DoDot:1
+15 ;Export to Delimited Excel format
+16 IF EXCEL>0
Begin DoDot:1
+17 WRITE !!,"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"
End DoDot:1
+18 QUIT
+19 ;
