RCDMCR4A.m

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 ---RCDMCR4A   11518     printed  Mar 13, 2025@20:48:15                                                                                                                                                                                                   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"