RCDMCR4A ;ALB/YG - 0 - 40 Percent SC Change Reconciliation Report - Input/output; Apr 9, 2019@21:06
;;4.5;Accounts Receivable;**347**;Mar 20, 1995;Build 47
;;Per VA Directive 6402, this routine should not be modified.
;
;This routine is being implemented for the AR Cross-Referencing 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 specified date range, who have a new Rated Disability
; during a user selected time period, and whose service update date is
; within user specified date range
;
MAIN ; Initial Interactive Processing
S:$G(U)="" U="^"
N STOPIT,EXCEL,RCSCR,RDDATE,RCBEGDT,RCENDDT,EOCBEGDT,EOCENDDT,EOCDATE,VLSDATE,VLSBEGDT,VLSENDDT,RPTTYPE
W !!,"*** Print the 0-40 Percent SC Change Reconciliation Report ***",!
;
S STOPIT=0 ; quit flag
;Prompt user for Date Range for Rated Disability Eligibility Changes
S RDDATE=$$DATE2^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 range for VistA Last Status Date
W !
S VLSDATE=$$DATE2^RCDMCUT2("Include Bills with VistA Last Status Date that fall within ","the Date Range for Rated Disability Changes:",RCBEGDT,RCENDDT,"VistA Last Status Update")
;Quit if user up arrowed or timed out
Q:+VLSDATE'>0
S VLSBEGDT=$P(VLSDATE,U,2),VLSENDDT=$P(VLSDATE,U,3)
;
;Prompt user for Date range for Episodes of Care Date
W !
S EOCDATE=$$DATE2^RCDMCUT2("Include Bills for Episodes of Care within User Selected Date Range:",,2880101,,"Episodes of Care")
;Quit if user up arrowed or timed out
Q:+EOCDATE'>0
S EOCBEGDT=$P(EOCDATE,U,2),EOCENDDT=$P(EOCDATE,U,3)
;
; Get Report Type (Detailed/Summary)
S STOPIT=0
S RPTTYPE=$$GETTYPE2^RCDMCUT2(.STOPIT)
Q:STOPIT>0!(RPTTYPE']"")
;
; 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."
;
; Logic from DEVICE^RCDMCUT2 copied here
N %ZIS,ZTSK,ZTRTN,ZTIO,ZTDESC,POP,ZTSAVE
S %ZIS="QM"
W ! D ^%ZIS
I POP S STOPIT=1 Q
; RCSCR is 1 if sent to screen
S RCSCR=$S($E($G(IOST),1,2)="C-":1,1:0)
; If report is Queued
I $D(IO("Q")) D Q
. S ZTRTN="RUN^RCDMCR4A"
. S ZTIO=ION
. S ZTSAVE("RCBEGDT")=""
. S ZTSAVE("RCENDDT")=""
. S ZTSAVE("EOCBEGDT")=""
. S ZTSAVE("EOCENDDT")=""
. S ZTSAVE("VLSBEGDT")=""
. S ZTSAVE("VLSENDDT")=""
. S ZTSAVE("RPTTYPE")=""
. S ZTSAVE("RCSCR")=""
. S ZTSAVE("EXCEL")=""
. S ZTDESC="DMC 0-40 Percent SC Change Reconciliation Report Process"
. D ^%ZTLOAD
. W !!,$S($D(ZTSK):"Request Queued. TASK = "_ZTSK,1:"REQUEST CANCELLED")
. D HOME^%ZIS
;
Q:STOPIT>0!($D(ZTQUEUED))
D RUN^RCDMCR4A
I 'STOPIT D PAUSE2^RCDMCUT2
Q
;
; Currently, Taskman schedulable option is not being planned for this report
; If this is going to change later on, QUERPT^RCDMCR3A would be a good example
; of how to do such an option
;
QUERPT ; Initial Taskman Scheduled Queued processing
; Set up parameters
; Run report
D RUN^RCDMCR4A
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
S STOPIT=0 ; quit flag
K ^TMP($J,"RCDMCR4")
S RCPAGE=0
; Collect the data in ^TMP($J,"RCDMCR4")
D COLLECT^RCDMCR4B(.STOPIT,RCBEGDT,RCENDDT,VLSBEGDT,VLSENDDT,EOCBEGDT,EOCENDDT,RPTTYPE)
Q:STOPIT>0
U IO
; Print Report using data in ^TMP
D REPORT
I 'RCSCR W !,@IOF
D ^%ZISC
K ^TMP($J,"RCDMCR4")
K EXCEL,RCSCR
Q
;
REPORT ;Print report
N RUNDATE,STATUS,NAME,SSN,CHGDT,RDNAME,RDSEXTRE,BILLNO
N SKIP,IBCNT,SCPER
S RUNDATE=$$FMTE^XLFDT($$NOW^XLFDT,"9MP")
D HDR
I +$D(^TMP($J,"RCDMCR4"))'>0 W !,"No data meets the criteria." Q
I RPTTYPE="S" D
. S NAME=""
. F S NAME=$O(^TMP($J,"RCDMCR4","SUMMARY",NAME)) Q:NAME']"" D Q:STOPIT
. . S SSN=""
. . F S SSN=$O(^TMP($J,"RCDMCR4","SUMMARY",NAME,SSN)) Q:SSN']"" D Q:STOPIT
. . . W !
. . . S SCPER=^TMP($J,"RCDMCR4","SUMMARY",NAME,SSN)
. . . I EXCEL>0 W NAME,U,SSN,U,+SCPER Q
. . . W $E(NAME,1,25) ; Veteran Name
. . . W ?27,SSN ; SSN
. . . W ?41,$J(+SCPER,2) ; Comb SC%
I RPTTYPE="D" D
. S NAME=""
. F S NAME=$O(^TMP($J,"RCDMCR4","DETAIL",NAME)) Q:NAME="" D Q:STOPIT
. . S SSN=""
. . F S SSN=$O(^TMP($J,"RCDMCR4","DETAIL",NAME,SSN)) Q:SSN="" D Q:STOPIT
. . . S CHGDT=""
. . . F S CHGDT=$O(^TMP($J,"RCDMCR4","DETAIL",NAME,SSN,CHGDT)) Q:CHGDT="" D Q:STOPIT
. . . . S RDNAME=""
. . . . F S RDNAME=$O(^TMP($J,"RCDMCR4","DETAIL",NAME,SSN,CHGDT,RDNAME)) Q:RDNAME="" D Q:STOPIT
. . . . . S RDSEXTRE=""
. . . . . F S RDSEXTRE=$O(^TMP($J,"RCDMCR4","DETAIL",NAME,SSN,CHGDT,RDNAME,RDSEXTRE)) Q:RDSEXTRE="" D Q:STOPIT
. . . . . . S BILLNO=""
. . . . . . F S BILLNO=$O(^TMP($J,"RCDMCR4","DETAIL",NAME,SSN,CHGDT,RDNAME,RDSEXTRE,BILLNO)) Q:BILLNO="" D Q:STOPIT
. . . . . . . S IBCNT=""
. . . . . . . F S IBCNT=$O(^TMP($J,"RCDMCR4","DETAIL",NAME,SSN,CHGDT,RDNAME,RDSEXTRE,BILLNO,IBCNT)) Q:IBCNT="" D Q:STOPIT
. . . . . . . . ; (NAME,SSN,RDCHGDT,RDNAME,RDSEXTRE,BILLNO,IBCNT)=RDORGDT_U_RXDT_U_OPTDT_U_DISCHDT_U_DSTATUS_U_SCPER_U_VLSDT_U_CHGAMT_U_$G(RXNUM)_U_$G(RXNAM)
. . . . . . . . N NODE,RDORGDT,RXDT,OPTDT,DISCHDT,STATUS,SCPER,VLSDT,CHGAMT,RXNUM,RXNAM
. . . . . . . . S NODE=$G(^TMP($J,"RCDMCR4","DETAIL",NAME,SSN,CHGDT,RDNAME,RDSEXTRE,BILLNO,IBCNT))
. . . . . . . . S RDORGDT=$P(NODE,U,1)
. . . . . . . . S RXDT=$P(NODE,U,2)
. . . . . . . . S OPTDT=$P(NODE,U,3)
. . . . . . . . S DISCHDT=$P(NODE,U,4)
. . . . . . . . S STATUS=$P(NODE,U,5)
. . . . . . . . S SCPER=$P(NODE,U,6)
. . . . . . . . S VLSDT=$P(NODE,U,7)
. . . . . . . . S CHGAMT=$P(NODE,U,8)
. . . . . . . . S RXNUM=$P(NODE,U,9)
. . . . . . . . S RXNAM=$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
I EXCEL'>0 D ULINE^RCDMCUT2("=",48)
Q
;
WRLINE ; Write the data formated report line
D CHKP() Q:STOPIT
W !
; Disable skip for now (as per direction of customer) with condition :0
I (NAME_SSN_+SCPER)'=$G(SKIP(1)) D
. W $E(NAME,1,13) ; Veteran Name
. W ?14,SSN ; SSN
. W ?24,$J(+SCPER,2) ; Comb SC%
. K SKIP(2),SKIP(3)
. S:0 SKIP(1)=NAME_SSN_+SCPER
I VLSDT'=$G(SKIP(2)) S:0 SKIP(2)=VLSDT W ?27,$$STRIP^XLFSTR($$FMTE^XLFDT(VLSDT,"8D")," ") ; Vista CHG Date
I RDNAME'=$G(SKIP(3)) S:0 SKIP(3)=RDNAME W ?35,$E(RDNAME,1,13) ; RD Name
W ?49,$E(RDSEXTRE,1,2)
W ?52,$S(RDORGDT="NODATE":RDORGDT,1:$$STRIP^XLFSTR($$FMTE^XLFDT(RDORGDT,"8D")," ")) ; RD Orig Date
W ?60,$P(BILLNO,"/",1) ; Bill Number
W:RDORGDT'="NODATE" ?72,$J("$"_$FN(CHGAMT,",",2),11) ; Charge Amount
; pick the later of OPTDT (outpatient) and DISCHDT (inpatient)
I DISCHDT>OPTDT W:DISCHDT>0 ?84,$$STRIP^XLFSTR($$FMTE^XLFDT(DISCHDT,"8D")," ")
E W:OPTDT>0 ?84,$$STRIP^XLFSTR($$FMTE^XLFDT(OPTDT,"8D")," ")
W:RXDT>0 ?92,$$STRIP^XLFSTR($$FMTE^XLFDT(RXDT,"8D")," ") ; Med Fill Date
W ?100,RXNUM ; RX #
W ?109,$E(RXNAM,1,12) ; RX Name
W ?123,$E(STATUS,1,9) ; This will be AR status for most cases, but for some, it will be IB Status ON HOLD
Q
;
WRLINE2 ; Write the Excel report line
W !
W $$EXOUT(NAME),U
W $$EXOUT(SSN),U
W +SCPER,U
W $$FMTE^XLFDT(VLSDT,"9D"),U
W RDNAME,U
W RDSEXTRE,U
I RDORGDT="NODATE" W "NODATE",U
W $S(RDORGDT="NODATE":"NODATE",1:$$FMTE^XLFDT(RDORGDT,"9D")),U
W $P(BILLNO,"/",1),U
W "$",$FN(CHGAMT,",",2),U
I DISCHDT>OPTDT W $$FMTE^XLFDT(DISCHDT,"9D")
E I OPTDT W $$FMTE^XLFDT(OPTDT,"9D")
W U
I RXDT W $$FMTE^XLFDT(RXDT,"9D")
W U
W RXNUM,U
W RXNAM,U
W STATUS
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 K SKIP
Q
EXOUT(DATA) ; Format data so Excel won't mess it up.
; Note - there are other ways Excel mangles data, but they are not expected in this report
S DATA=$TR(DATA,"""","")
I DATA?1"0".N S DATA=""""_DATA_"""" Q DATA
I DATA["," S DATA=""""_DATA_""""
Q DATA
;
HDR ;Print Report Header
; See WRLINE for header positions
I EXCEL>0 D Q
. W !,"Veteran Name",U,"SSN",U,"Comb SC %"
. I RPTTYPE="S" Q
. W U,"VistA Chd Date",U,"RD Name",U,"Ext",U,"RD Orig Date",U,"Bill Number",U,"Charge Amount",U,"Medical Care Date",U,"RXFillDT",U,"RX #",U,"RX Name",U,"Status"
S RCPAGE=RCPAGE+1
W @IOF,"0-40 Percent SC Change Reconciliation ",$S(RPTTYPE="D":"Detailed",1:"Summary")," Report -- Run Date: ",RUNDATE," --"
W ?122,"Page "_RCPAGE
W !?6,"RD Change Dates from ",$$FMTE^XLFDT(RCBEGDT,"9D")," to ",$$FMTE^XLFDT(RCENDDT,"9D")
W ?57,"VistA Change Dates from ",$$FMTE^XLFDT(VLSBEGDT,"9D")," to ",$$FMTE^XLFDT(VLSENDDT,"9D")
W !,?6,"Episode of Care Dates from ",$$FMTE^XLFDT(EOCBEGDT,"9D")," to ",$$FMTE^XLFDT(EOCENDDT,"9D")
W !
;Print to screen or printer
I RPTTYPE="S" D
. W !,?40,"Comb"
. W !,?5,"Veteran Name",?30,"SSN",?40,"SC %"
I RPTTYPE="D" D
. W !," Medical"
. W !," Comb VistA RD Orig Charge Care"
. W !," Veteran Name SSN SC % Chd Date RD Name Ext Date Bill Number Amount Date RXFillDT RX # RX Name Status"
D ULINE^RCDMCUT2("=",$G(IOM))
Q
; Support Utility to find test cases. Not a part of code executed by users, just by testers
; This utility is provided since currently there is no way to see data in file 390 anywhere except
; RDEC report, and RDEC is not useful for testers
;
; As a testers only code, it is not fully coded per usual standards
RDINFO ;
N DR,D,DFN,ND,OCC,PN
K ^TMP($J)
S DFN=""
R !,"Patient Name or SSN: ",PN:99999 Q:PN="^"
I PN'="" D
. I PN?9N S DFN=$O(^DPT("SSN",PN,"")) I DFN Q
. I PN'?9N,$D(^DPT("B",PN)) S DFN=$O(^DPT("B",PN,"")) I DFN Q
. I PN'?9N,'DFN S PN=$O(^DPT("B",PN)),DFN=$O(^DPT("B",PN,"")) W !,"Patient ",PN
W ! S DR=$$DATE2^RCDMCUT2(" Enter the Date Range for Rated Disability Changes.")
I 'DR Q
D RDCHG^DGENRDUA(DFN,$P(DR,U,2),$P(DR,U,3))
S DFN="" F S DFN=$O(^TMP($J,"RDCHG",DFN)) Q:DFN="" D
. W !!,"Patient ",DFN," ",$P(^DPT(DFN,0),U)
. S D=$P($G(^DPT(DFN,.361)),U,2) W " Vista Chg DT: " I D W $E(D,4,5),"/",$E(D,6,7),"/",$E(D,1,3)+1700
. W !," COMB SC%: ",$P($G(^DPT(DFN,.3)),U,2)
. S D=$P($G(^DPT(DFN,.3)),U,14)
. I D W " EFF. DATE: ",$E(D,4,5),"/",$E(D,6,7),"/",$E(D,1,3)+1700
. W !
. F OCC=1:1 S ND=$G(^TMP($J,"RDCHG",DFN,OCC)) Q:ND="" D
. . S D=$P(ND,U)
. . W !,OCC,?5,"RD Change: " I D W $E(D,4,5),"/",$E(D,6,7),"/",$E(D,1,3)+1700
. . W " RD Name: ",$E($P(ND,U,3),1,30)
. . W " RD %: ",$P(ND,U,4)
. . W !,?5
. . W " RD Extremity: ",$P(ND,U,6)
. . S D=$P(ND,U,7)
. . I D W " RD Orig: ",$E(D,4,5),"/",$E(D,6,7),"/",$E(D,1,3)+1700
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDMCR4A 11518 printed Sep 23, 2025@19:19:36 Page 2
RCDMCR4A ;ALB/YG - 0 - 40 Percent SC Change Reconciliation Report - Input/output; Apr 9, 2019@21:06
+1 ;;4.5;Accounts Receivable;**347**;Mar 20, 1995;Build 47
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;This routine is being implemented for the AR Cross-Referencing 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 specified date range, who have a new Rated Disability
+12 ; during a user selected time period, and whose service update date is
+13 ; within user specified date range
+14 ;
MAIN ; Initial Interactive Processing
+1 if $GET(U)=""
SET U="^"
+2 NEW STOPIT,EXCEL,RCSCR,RDDATE,RCBEGDT,RCENDDT,EOCBEGDT,EOCENDDT,EOCDATE,VLSDATE,VLSBEGDT,VLSENDDT,RPTTYPE
+3 WRITE !!,"*** Print the 0-40 Percent SC Change Reconciliation Report ***",!
+4 ;
+5 ; quit flag
SET STOPIT=0
+6 ;Prompt user for Date Range for Rated Disability Eligibility Changes
+7 SET RDDATE=$$DATE2^RCDMCUT2(" Enter the Date Range for Rated Disability Changes.")
+8 ;Quit is user up arrowed or timed out
+9 if RDDATE'>0
QUIT
+10 SET RCBEGDT=$PIECE(RDDATE,U,2)
SET RCENDDT=$PIECE(RDDATE,U,3)
+11 ;
+12 ;Prompt user for Date range for VistA Last Status Date
+13 WRITE !
+14 SET VLSDATE=$$DATE2^RCDMCUT2("Include Bills with VistA Last Status Date that fall within ","the Date Range for Rated Disability Changes:",RCBEGDT,RCENDDT,"VistA Last Status Update")
+15 ;Quit if user up arrowed or timed out
+16 if +VLSDATE'>0
QUIT
+17 SET VLSBEGDT=$PIECE(VLSDATE,U,2)
SET VLSENDDT=$PIECE(VLSDATE,U,3)
+18 ;
+19 ;Prompt user for Date range for Episodes of Care Date
+20 WRITE !
+21 SET EOCDATE=$$DATE2^RCDMCUT2("Include Bills for Episodes of Care within User Selected Date Range:",,2880101,,"Episodes of Care")
+22 ;Quit if user up arrowed or timed out
+23 if +EOCDATE'>0
QUIT
+24 SET EOCBEGDT=$PIECE(EOCDATE,U,2)
SET EOCENDDT=$PIECE(EOCDATE,U,3)
+25 ;
+26 ; Get Report Type (Detailed/Summary)
+27 SET STOPIT=0
+28 SET RPTTYPE=$$GETTYPE2^RCDMCUT2(.STOPIT)
+29 if STOPIT>0!(RPTTYPE']"")
QUIT
+30 ;
+31 ; Prompt user if report will be Excel Delimited format:
+32 SET EXCEL=$$EXCEL^RCDMCUT2
+33 ;Quit is user up arrowed or timed out
+34 if EXCEL="^"
QUIT
+35 if EXCEL>0
DO EXMSG^RCDMCUT2
+36 if EXCEL'>0
Begin DoDot:1
+37 WRITE !!,"This report may take a while to process. It is recommended that"
+38 WRITE !,"you Queue this report to a device that is 132 characters wide."
End DoDot:1
+39 ;
+40 ; Logic from DEVICE^RCDMCUT2 copied here
+41 NEW %ZIS,ZTSK,ZTRTN,ZTIO,ZTDESC,POP,ZTSAVE
+42 SET %ZIS="QM"
+43 WRITE !
DO ^%ZIS
+44 IF POP
SET STOPIT=1
QUIT
+45 ; RCSCR is 1 if sent to screen
+46 SET RCSCR=$SELECT($EXTRACT($GET(IOST),1,2)="C-":1,1:0)
+47 ; If report is Queued
+48 IF $DATA(IO("Q"))
Begin DoDot:1
+49 SET ZTRTN="RUN^RCDMCR4A"
+50 SET ZTIO=ION
+51 SET ZTSAVE("RCBEGDT")=""
+52 SET ZTSAVE("RCENDDT")=""
+53 SET ZTSAVE("EOCBEGDT")=""
+54 SET ZTSAVE("EOCENDDT")=""
+55 SET ZTSAVE("VLSBEGDT")=""
+56 SET ZTSAVE("VLSENDDT")=""
+57 SET ZTSAVE("RPTTYPE")=""
+58 SET ZTSAVE("RCSCR")=""
+59 SET ZTSAVE("EXCEL")=""
+60 SET ZTDESC="DMC 0-40 Percent SC Change Reconciliation Report Process"
+61 DO ^%ZTLOAD
+62 WRITE !!,$SELECT($DATA(ZTSK):"Request Queued. TASK = "_ZTSK,1:"REQUEST CANCELLED")
+63 DO HOME^%ZIS
End DoDot:1
QUIT
+64 ;
+65 if STOPIT>0!($DATA(ZTQUEUED))
QUIT
+66 DO RUN^RCDMCR4A
+67 IF 'STOPIT
DO PAUSE2^RCDMCUT2
+68 QUIT
+69 ;
+70 ; Currently, Taskman schedulable option is not being planned for this report
+71 ; If this is going to change later on, QUERPT^RCDMCR3A would be a good example
+72 ; of how to do such an option
+73 ;
QUERPT ; Initial Taskman Scheduled Queued processing
+1 ; Set up parameters
+2 ; Run report
+3 DO RUN^RCDMCR4A
+4 QUIT
+5 ;
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 ; quit flag
SET STOPIT=0
+5 KILL ^TMP($JOB,"RCDMCR4")
+6 SET RCPAGE=0
+7 ; Collect the data in ^TMP($J,"RCDMCR4")
+8 DO COLLECT^RCDMCR4B(.STOPIT,RCBEGDT,RCENDDT,VLSBEGDT,VLSENDDT,EOCBEGDT,EOCENDDT,RPTTYPE)
+9 if STOPIT>0
QUIT
+10 USE IO
+11 ; Print Report using data in ^TMP
+12 DO REPORT
+13 IF 'RCSCR
WRITE !,@IOF
+14 DO ^%ZISC
+15 KILL ^TMP($JOB,"RCDMCR4")
+16 KILL EXCEL,RCSCR
+17 QUIT
+18 ;
REPORT ;Print report
+1 NEW RUNDATE,STATUS,NAME,SSN,CHGDT,RDNAME,RDSEXTRE,BILLNO
+2 NEW SKIP,IBCNT,SCPER
+3 SET RUNDATE=$$FMTE^XLFDT($$NOW^XLFDT,"9MP")
+4 DO HDR
+5 IF +$DATA(^TMP($JOB,"RCDMCR4"))'>0
WRITE !,"No data meets the criteria."
QUIT
+6 IF RPTTYPE="S"
Begin DoDot:1
+7 SET NAME=""
+8 FOR
SET NAME=$ORDER(^TMP($JOB,"RCDMCR4","SUMMARY",NAME))
if NAME']""
QUIT
Begin DoDot:2
+9 SET SSN=""
+10 FOR
SET SSN=$ORDER(^TMP($JOB,"RCDMCR4","SUMMARY",NAME,SSN))
if SSN']""
QUIT
Begin DoDot:3
+11 WRITE !
+12 SET SCPER=^TMP($JOB,"RCDMCR4","SUMMARY",NAME,SSN)
+13 IF EXCEL>0
WRITE NAME,U,SSN,U,+SCPER
QUIT
+14 ; Veteran Name
WRITE $EXTRACT(NAME,1,25)
+15 ; SSN
WRITE ?27,SSN
+16 ; Comb SC%
WRITE ?41,$JUSTIFY(+SCPER,2)
End DoDot:3
if STOPIT
QUIT
End DoDot:2
if STOPIT
QUIT
End DoDot:1
+17 IF RPTTYPE="D"
Begin DoDot:1
+18 SET NAME=""
+19 FOR
SET NAME=$ORDER(^TMP($JOB,"RCDMCR4","DETAIL",NAME))
if NAME=""
QUIT
Begin DoDot:2
+20 SET SSN=""
+21 FOR
SET SSN=$ORDER(^TMP($JOB,"RCDMCR4","DETAIL",NAME,SSN))
if SSN=""
QUIT
Begin DoDot:3
+22 SET CHGDT=""
+23 FOR
SET CHGDT=$ORDER(^TMP($JOB,"RCDMCR4","DETAIL",NAME,SSN,CHGDT))
if CHGDT=""
QUIT
Begin DoDot:4
+24 SET RDNAME=""
+25 FOR
SET RDNAME=$ORDER(^TMP($JOB,"RCDMCR4","DETAIL",NAME,SSN,CHGDT,RDNAME))
if RDNAME=""
QUIT
Begin DoDot:5
+26 SET RDSEXTRE=""
+27 FOR
SET RDSEXTRE=$ORDER(^TMP($JOB,"RCDMCR4","DETAIL",NAME,SSN,CHGDT,RDNAME,RDSEXTRE))
if RDSEXTRE=""
QUIT
Begin DoDot:6
+28 SET BILLNO=""
+29 FOR
SET BILLNO=$ORDER(^TMP($JOB,"RCDMCR4","DETAIL",NAME,SSN,CHGDT,RDNAME,RDSEXTRE,BILLNO))
if BILLNO=""
QUIT
Begin DoDot:7
+30 SET IBCNT=""
+31 FOR
SET IBCNT=$ORDER(^TMP($JOB,"RCDMCR4","DETAIL",NAME,SSN,CHGDT,RDNAME,RDSEXTRE,BILLNO,IBCNT))
if IBCNT=""
QUIT
Begin DoDot:8
+32 ; (NAME,SSN,RDCHGDT,RDNAME,RDSEXTRE,BILLNO,IBCNT)=RDORGDT_U_RXDT_U_OPTDT_U_DISCHDT_U_DSTATUS_U_SCPER_U_VLSDT_U_CHGAMT_U_$G(RXNUM)_U_$G(RXNAM)
+33 NEW NODE,RDORGDT,RXDT,OPTDT,DISCHDT,STATUS,SCPER,VLSDT,CHGAMT,RXNUM,RXNAM
+34 SET NODE=$GET(^TMP($JOB,"RCDMCR4","DETAIL",NAME,SSN,CHGDT,RDNAME,RDSEXTRE,BILLNO,IBCNT))
+35 SET RDORGDT=$PIECE(NODE,U,1)
+36 SET RXDT=$PIECE(NODE,U,2)
+37 SET OPTDT=$PIECE(NODE,U,3)
+38 SET DISCHDT=$PIECE(NODE,U,4)
+39 SET STATUS=$PIECE(NODE,U,5)
+40 SET SCPER=$PIECE(NODE,U,6)
+41 SET VLSDT=$PIECE(NODE,U,7)
+42 SET CHGAMT=$PIECE(NODE,U,8)
+43 SET RXNUM=$PIECE(NODE,U,9)
+44 SET RXNAM=$PIECE(NODE,U,10)
+45 IF EXCEL'>0
DO WRLINE
QUIT
+46 IF EXCEL>0
DO WRLINE2
QUIT
End DoDot:8
if STOPIT
QUIT
End DoDot:7
if STOPIT
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
+47 ;Don't print summary if user ^ out
+48 if STOPIT
QUIT
+49 IF EXCEL'>0
DO ULINE^RCDMCUT2("=",48)
+50 QUIT
+51 ;
WRLINE ; Write the data formated report line
+1 DO CHKP()
if STOPIT
QUIT
+2 WRITE !
+3 ; Disable skip for now (as per direction of customer) with condition :0
+4 IF (NAME_SSN_+SCPER)'=$GET(SKIP(1))
Begin DoDot:1
+5 ; Veteran Name
WRITE $EXTRACT(NAME,1,13)
+6 ; SSN
WRITE ?14,SSN
+7 ; Comb SC%
WRITE ?24,$JUSTIFY(+SCPER,2)
+8 KILL SKIP(2),SKIP(3)
+9 if 0
SET SKIP(1)=NAME_SSN_+SCPER
End DoDot:1
+10 ; Vista CHG Date
IF VLSDT'=$GET(SKIP(2))
if 0
SET SKIP(2)=VLSDT
WRITE ?27,$$STRIP^XLFSTR($$FMTE^XLFDT(VLSDT,"8D")," ")
+11 ; RD Name
IF RDNAME'=$GET(SKIP(3))
if 0
SET SKIP(3)=RDNAME
WRITE ?35,$EXTRACT(RDNAME,1,13)
+12 WRITE ?49,$EXTRACT(RDSEXTRE,1,2)
+13 ; RD Orig Date
WRITE ?52,$SELECT(RDORGDT="NODATE":RDORGDT,1:$$STRIP^XLFSTR($$FMTE^XLFDT(RDORGDT,"8D")," "))
+14 ; Bill Number
WRITE ?60,$PIECE(BILLNO,"/",1)
+15 ; Charge Amount
if RDORGDT'="NODATE"
WRITE ?72,$JUSTIFY("$"_$FNUMBER(CHGAMT,",",2),11)
+16 ; pick the later of OPTDT (outpatient) and DISCHDT (inpatient)
+17 IF DISCHDT>OPTDT
if DISCHDT>0
WRITE ?84,$$STRIP^XLFSTR($$FMTE^XLFDT(DISCHDT,"8D")," ")
+18 IF '$TEST
if OPTDT>0
WRITE ?84,$$STRIP^XLFSTR($$FMTE^XLFDT(OPTDT,"8D")," ")
+19 ; Med Fill Date
if RXDT>0
WRITE ?92,$$STRIP^XLFSTR($$FMTE^XLFDT(RXDT,"8D")," ")
+20 ; RX #
WRITE ?100,RXNUM
+21 ; RX Name
WRITE ?109,$EXTRACT(RXNAM,1,12)
+22 ; This will be AR status for most cases, but for some, it will be IB Status ON HOLD
WRITE ?123,$EXTRACT(STATUS,1,9)
+23 QUIT
+24 ;
WRLINE2 ; Write the Excel report line
+1 WRITE !
+2 WRITE $$EXOUT(NAME),U
+3 WRITE $$EXOUT(SSN),U
+4 WRITE +SCPER,U
+5 WRITE $$FMTE^XLFDT(VLSDT,"9D"),U
+6 WRITE RDNAME,U
+7 WRITE RDSEXTRE,U
+8 IF RDORGDT="NODATE"
WRITE "NODATE",U
+9 WRITE $SELECT(RDORGDT="NODATE":"NODATE",1:$$FMTE^XLFDT(RDORGDT,"9D")),U
+10 WRITE $PIECE(BILLNO,"/",1),U
+11 WRITE "$",$FNUMBER(CHGAMT,",",2),U
+12 IF DISCHDT>OPTDT
WRITE $$FMTE^XLFDT(DISCHDT,"9D")
+13 IF '$TEST
IF OPTDT
WRITE $$FMTE^XLFDT(OPTDT,"9D")
+14 WRITE U
+15 IF RXDT
WRITE $$FMTE^XLFDT(RXDT,"9D")
+16 WRITE U
+17 WRITE RXNUM,U
+18 WRITE RXNAM,U
+19 WRITE STATUS
+20 QUIT
+21 ;
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
KILL SKIP
+5 QUIT
EXOUT(DATA) ; Format data so Excel won't mess it up.
+1 ; Note - there are other ways Excel mangles data, but they are not expected in this report
+2 SET DATA=$TRANSLATE(DATA,"""","")
+3 IF DATA?1"0".N
SET DATA=""""_DATA_""""
QUIT DATA
+4 IF DATA[","
SET DATA=""""_DATA_""""
+5 QUIT DATA
+6 ;
HDR ;Print Report Header
+1 ; See WRLINE for header positions
+2 IF EXCEL>0
Begin DoDot:1
+3 WRITE !,"Veteran Name",U,"SSN",U,"Comb SC %"
+4 IF RPTTYPE="S"
QUIT
+5 WRITE U,"VistA Chd Date",U,"RD Name",U,"Ext",U,"RD Orig Date",U,"Bill Number",U,"Charge Amount",U,"Medical Care Date",U,"RXFillDT",U,"RX #",U,"RX Name",U,"Status"
End DoDot:1
QUIT
+6 SET RCPAGE=RCPAGE+1
+7 WRITE @IOF,"0-40 Percent SC Change Reconciliation ",$SELECT(RPTTYPE="D":"Detailed",1:"Summary")," Report -- Run Date: ",RUNDATE," --"
+8 WRITE ?122,"Page "_RCPAGE
+9 WRITE !?6,"RD Change Dates from ",$$FMTE^XLFDT(RCBEGDT,"9D")," to ",$$FMTE^XLFDT(RCENDDT,"9D")
+10 WRITE ?57,"VistA Change Dates from ",$$FMTE^XLFDT(VLSBEGDT,"9D")," to ",$$FMTE^XLFDT(VLSENDDT,"9D")
+11 WRITE !,?6,"Episode of Care Dates from ",$$FMTE^XLFDT(EOCBEGDT,"9D")," to ",$$FMTE^XLFDT(EOCENDDT,"9D")
+12 WRITE !
+13 ;Print to screen or printer
+14 IF RPTTYPE="S"
Begin DoDot:1
+15 WRITE !,?40,"Comb"
+16 WRITE !,?5,"Veteran Name",?30,"SSN",?40,"SC %"
End DoDot:1
+17 IF RPTTYPE="D"
Begin DoDot:1
+18 WRITE !," Medical"
+19 WRITE !," Comb VistA RD Orig Charge Care"
+20 WRITE !," Veteran Name SSN SC % Chd Date RD Name Ext Date Bill Number Amount Date RXFillDT RX # RX Name Status"
End DoDot:1
+21 DO ULINE^RCDMCUT2("=",$GET(IOM))
+22 QUIT
+23 ; Support Utility to find test cases. Not a part of code executed by users, just by testers
+24 ; This utility is provided since currently there is no way to see data in file 390 anywhere except
+25 ; RDEC report, and RDEC is not useful for testers
+26 ;
+27 ; As a testers only code, it is not fully coded per usual standards
RDINFO ;
+1 NEW DR,D,DFN,ND,OCC,PN
+2 KILL ^TMP($JOB)
+3 SET DFN=""
+4 READ !,"Patient Name or SSN: ",PN:99999
if PN="^"
QUIT
+5 IF PN'=""
Begin DoDot:1
+6 IF PN?9N
SET DFN=$ORDER(^DPT("SSN",PN,""))
IF DFN
QUIT
+7 IF PN'?9N
IF $DATA(^DPT("B",PN))
SET DFN=$ORDER(^DPT("B",PN,""))
IF DFN
QUIT
+8 IF PN'?9N
IF 'DFN
SET PN=$ORDER(^DPT("B",PN))
SET DFN=$ORDER(^DPT("B",PN,""))
WRITE !,"Patient ",PN
End DoDot:1
+9 WRITE !
SET DR=$$DATE2^RCDMCUT2(" Enter the Date Range for Rated Disability Changes.")
+10 IF 'DR
QUIT
+11 DO RDCHG^DGENRDUA(DFN,$PIECE(DR,U,2),$PIECE(DR,U,3))
+12 SET DFN=""
FOR
SET DFN=$ORDER(^TMP($JOB,"RDCHG",DFN))
if DFN=""
QUIT
Begin DoDot:1
+13 WRITE !!,"Patient ",DFN," ",$PIECE(^DPT(DFN,0),U)
+14 SET D=$PIECE($GET(^DPT(DFN,.361)),U,2)
WRITE " Vista Chg DT: "
IF D
WRITE $EXTRACT(D,4,5),"/",$EXTRACT(D,6,7),"/",$EXTRACT(D,1,3)+1700
+15 WRITE !," COMB SC%: ",$PIECE($GET(^DPT(DFN,.3)),U,2)
+16 SET D=$PIECE($GET(^DPT(DFN,.3)),U,14)
+17 IF D
WRITE " EFF. DATE: ",$EXTRACT(D,4,5),"/",$EXTRACT(D,6,7),"/",$EXTRACT(D,1,3)+1700
+18 WRITE !
+19 FOR OCC=1:1
SET ND=$GET(^TMP($JOB,"RDCHG",DFN,OCC))
if ND=""
QUIT
Begin DoDot:2
+20 SET D=$PIECE(ND,U)
+21 WRITE !,OCC,?5,"RD Change: "
IF D
WRITE $EXTRACT(D,4,5),"/",$EXTRACT(D,6,7),"/",$EXTRACT(D,1,3)+1700
+22 WRITE " RD Name: ",$EXTRACT($PIECE(ND,U,3),1,30)
+23 WRITE " RD %: ",$PIECE(ND,U,4)
+24 WRITE !,?5
+25 WRITE " RD Extremity: ",$PIECE(ND,U,6)
+26 SET D=$PIECE(ND,U,7)
+27 IF D
WRITE " RD Orig: ",$EXTRACT(D,4,5),"/",$EXTRACT(D,6,7),"/",$EXTRACT(D,1,3)+1700
End DoDot:2
End DoDot:1
+28 QUIT
