Routine: RCDMCR8A

RCDMCR8A ;ALB/YG - Pension Report Exempt Charge Reconciliation Report - Input/output; Jun 16, 2021@14:23

 ;;4.5;Accounts Receivable;**384**;Jun 16, 2021;Build 29

 ;;Per VA Directive 6402, this routine should not be modified.

 ;This routine is being implemented for the AR Cross-Servicing Project

 ; This report assists users in reviewing all bills containing charges

 ; with a distinct date of service on or after the co-payment exemption

 ; effective date for Veterans with Primary or Secondary Eligibility equal

 ; Pension

 ;  The report captures any charges without an IB status of cancelled, and

 ; with an AR Status of Active, Open, Suspended, Write-Off, or Collected/

 ; Closed or an IB Status of On-Hold, with a date of service on or after

 ; the exemption effective date.

MAIN ; Initial Interactive Processing

 N ZTQUEUED,ZTREQ

 S:$G(U)="" U="^"

 N STOPIT,EXCEL,RCSCR,ARTYPE,NDTFLAG

 W !!,"*** Print the Pension Exempt Charge Recon Report ***",!

 S STOPIT=0 ; quit flag

 ; Get Status

 ;S ARTYPE=$$ARSTAT^RCDMCUT2(.STOPIT)

 S ARTYPE=$$ARSTAT(.STOPIT)

 Q:STOPIT>0!(ARTYPE']"")

 S NDTFLAG=0

 D  Q:NDTFLAG="^"

 . N Y

 . K DIR,DIRUT,DTOUT,DIROUT,DUOUT

 . S DIR(0)="Y",DIR("B")="NO",DIR("T")=DTIME W !

 . S DIR("A")="Show veterans with missing Exempt Date"

 . D ^DIR S NDTFLAG=$G(Y)

 . S:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) NDTFLAG="^"

 . K DIR,DIRUT,DTOUT,DIROUT,DUOUT,Y

 ; 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."

 N %ZIS,ZTSK,ZTRTN,ZTIO,ZTDESC,POP,ZTSAVE

 S %ZIS="QM"

 W ! D ^%ZIS

 I POP S STOPIT=1 Q

 S RCSCR=$S($E($G(IOST),1,2)="C-":1,1:0)

 I $D(IO("Q")) D  S STOPIT=1

 . S ZTRTN="RUN^RCDMCR8A"

 . S ZTIO=ION

 . S ZTSAVE("RCSCR")=""

 . S ZTSAVE("ARTYPE")=""

 . S ZTSAVE("EXCEL")=""

 . S ZTSAVE("NDTFLAG")=""

 . S ZTDESC="Pension Exempt Charge Recon 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^RCDMCR8A

 I STOPIT'=2 D PAUSE2^RCDMCUT2

RUN ;Get data and Print it out

 ;If queued ensure you delete it from the TASKS file

 I $D(ZTQUEUED) S ZTREQ="@"

 N RCPAGE

 K ^TMP($J,"RCDMCR8")

 S RCPAGE=0,STOPIT=$G(STOPIT)

 ; Collect the data in ^TMP

 D COLLECT^RCDMCR8B(.STOPIT,ARTYPE)

 Q:$G(STOPIT)>0

 U IO

 ; Print Report using data in ^TMP

 D REPORT

 I 'RCSCR W !,@IOF

 D ^%ZISC

 K ^TMP($J,"RCDMCR8")

 K EXCEL,RCSCR,TESTDATE

REPORT ;Print report

 N RUNDATE,STATUS,NAME,SSN,BILLNO,IBIEN,SKIP,DISCHDT

 S RUNDATE=$$FMTE^XLFDT($$NOW^XLFDT,"9MP")

 D HDR

 I +$D(^TMP($J,"RCDMCR8"))'>0 W !,"No data meets the criteria." Q

 K SKIP

 S NAME=""

 F  S NAME=$O(^TMP($J,"RCDMCR8","DETAIL",NAME)) Q:NAME']""  D  Q:STOPIT

 . S SSN=""

 . F  S SSN=$O(^TMP($J,"RCDMCR8","DETAIL",NAME,SSN)) Q:SSN']""  D  Q:STOPIT

 . . S BILLNO=""

 . . F  S BILLNO=$O(^TMP($J,"RCDMCR8","DETAIL",NAME,SSN,BILLNO)) Q:BILLNO']""  D  Q:STOPIT

 . . . S IBIEN=""

 . . . F  S IBIEN=$O(^TMP($J,"RCDMCR8","DETAIL",NAME,SSN,BILLNO,IBIEN)) Q:IBIEN']""  D  Q:STOPIT

 . . . . N NODE,SERVDT,RXDT,ELIG,EXEMPTDT,RXNUM,RXNAM,STATUS,ELIGTYP,PNTERMDT

 . . . . ; S ^TMP($J,"RCDMCR8","DETAIL",NAME,SSN,BILLNO,IBIEN)=SERVDT_U_RXDT_U_ELIG_U_EXEMPTDT_U_RXNUM_U_RXNAM_U_STATUS_U_ELIGTYP

 . . . . S NODE=$G(^TMP($J,"RCDMCR8","DETAIL",NAME,SSN,BILLNO,IBIEN))

 . . . . S SERVDT=$S($P(NODE,U,10)'="":$P(NODE,U,10),1:$P(NODE,U,1))

 . . . . S RXDT=$P(NODE,U,2)

 . . . . S ELIG=$P(NODE,U,3)

 . . . . S EXEMPTDT=$P(NODE,U,4)

 . . . . S RXNUM=$P(NODE,U,5)

 . . . . S RXNAM=$P(NODE,U,6)

 . . . . S STATUS=$P(NODE,U,7)

 . . . . S ELIGTYP=$P(NODE,U,8)

 . . . . S PNTERMDT=$P(NODE,U,9) ;Pension Termination Date

 . . . . S DISCHDT=$P(NODE,U,11) ;Discharge Date

 . . . . I EXCEL'>0 D WRLINE Q

 . . . . I EXCEL>0 D WRLINE2 Q

WRLINE ; Write the data formated report line

 ; Columns are - position, width, spacing (offset header by)

 ;Veteran Name - 1,23,1

 ;Pat/ID (1st char Last Name + Last 4 of SSN) - 25,5,2

 ;Bill # - 32,11,1

 ;EXMPTDT - 44,7,2

 ;PNTERMDT - 53,7,3

 ;Med Care Date - 63,7,1

 ;D/C Date - 72,8,2

 ;RXFillDT - 82,7,2

 ;RX # - 91,9,1

 ;RX Name - 101,22,1

 ;Status - 124,9,1

 D CHKP() Q:STOPIT

 I NDTFLAG=0,EXEMPTDT="NODATE" Q

W !

 W $E(NAME,1,23) ; Veteran Name

 W ?24,$E(NAME,1)_$E(SSN,$L(SSN)-3,$L(SSN)) ; 1st char last name + Last 4 of SSN

 W ?31,$P(BILLNO,"/",1) ; Bill Number

 I EXEMPTDT="NODATE" W ?43,EXEMPTDT Q

 W ?43,$$STRIP^XLFSTR($$FMTE^XLFDT(EXEMPTDT,"8D")," ")

 W:PNTERMDT>0 ?52,$$STRIP^XLFSTR($$FMTE^XLFDT(PNTERMDT,"8D")," ")

 W:SERVDT>0 ?62,$$STRIP^XLFSTR($$FMTE^XLFDT(SERVDT,"8D")," ")

 W:DISCHDT>0 ?70,$$STRIP^XLFSTR($$FMTE^XLFDT(DISCHDT,"8D")," ") ;Discharge Date

 W:RXDT>0 ?80,$$STRIP^XLFSTR($$FMTE^XLFDT(RXDT,"8D")," ") ; Med Fill Date

 W ?89,RXNUM ; RX #

 W ?99,$E(RXNAM,1,22) ; RX Name

 W ?122,$E(STATUS,1,9)

 ;W:RXDT>0 ?71,$$STRIP^XLFSTR($$FMTE^XLFDT(RXDT,"8D")," ") ; Med Fill Date

 ;W ?79,RXNUM ; RX #

 ;W ?89,$E(RXNAM,1,22) ; RX Name

 ;W ?112,$E(STATUS,1,9)

 ;W ?122,$E(ELIGTYP,1,4)

WRLINE2 ; Write the Excel report line

 I NDTFLAG=0,EXEMPTDT="NODATE" Q

W !

 W NAME,U

 W $E(NAME,1)_$E(SSN,$L(SSN)-3,$L(SSN)),U

 W $P(BILLNO,"/",1),U

 I EXEMPTDT="NODATE" W EXEMPTDT,U,U,U,U,U,U,U Q

 W:EXEMPTDT $$FMTE^XLFDT(EXEMPTDT,"9D") W U

 W:PNTERMDT $$FMTE^XLFDT(PNTERMDT,"9D") W U

 W:SERVDT $$FMTE^XLFDT(SERVDT,"9D") W U

 W:DISCHDT $$FMTE^XLFDT(DISCHDT,"9D") W U

 W:RXDT $$FMTE^XLFDT(RXDT,"9D") W U

 W RXNUM,U

 W RXNAM,U

 W STATUS,U

 ;W ELIGTYP,U

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

HDR ;Print Report Header

 I EXCEL>0 D  Q

 . W !,"Veteran Name",U,"Pat/ID",U

 . W "Bill #",U,"EXMPTDT",U,"PenTermDt",U,"Med Care Date",U,"D/C Date",U,"RXFillDT",U,"RX #",U,"RX Name",U,"Status"

 S RCPAGE=RCPAGE+1

 W @IOF,"Pension Exempt Charge Reconciliation Report  -- Run Date: ",RUNDATE," --"

 W ?122,"Page "_RCPAGE

 ;Print to screen or printer

 W !,"Veteran Name",?24,"Pat/ID",?31,"Bill #",?43,"EXMPTDT",?52,"PenTermDt",?62,"MedC DT",?70,"D/C Date",?80,"RXFillDT",?89,"RX #",?99,"RX Name",?122,"Status"

 D ULINE^RCDMCUT2("=",$G(IOM))

ARSTAT(STOPIT) ;Chose AR status

 N C,SL,J,TEMP

 S SL=0

 F J=1:1:10 D  Q:SL=0

 . S SL=0

 . D MENU

 . I Y=7 Q

 . I Y="^"!(Y="") S STOPIT=1 Q

 . I $E(Y,$L(Y))="," S Y=$E(Y,1,$L(Y)-1)

 . F C=1:1:$L(Y,",") Q:SL!(Y=7)  D

 . . S TEMP=$P(Y,",",C)

 . . I TEMP>7!(TEMP<1) S SL=1 Q

 . . I TEMP=7 S Y=7 Q

Q Y

MENU ;

 W !,?5,"1 - Active"

 W !,?5,"2 - Open"

 W !,?5,"3 - Suspended"

 W !,?5,"4 - Collected/Closed"

 W !,?5,"5 - IB On-Hold"

 W !,?5,"6 - Write-Off"

 W !,?5,"7 - ALL (Includes 1-6 and AR CANCELLATIONS)",!

 N DIR

 K X,Y

 S DIR(0)="LO^1:7"

 S DIR("B")=7

 D ^DIR

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDMCR8A   7187     printed  Mar 13, 2025@20:48:23                                                                                                                                                                                                    Page 2

RCDMCR8A  ;ALB/YG - Pension Report Exempt Charge Reconciliation Report - Input/output; Jun 16, 2021@14:23

 +1       ;;4.5;Accounts Receivable;**384**;Jun 16, 2021;Build 29

 +2       ;;Per VA Directive 6402, this routine should not be modified.

 +3       ;

 +4       ;This routine is being implemented for the AR Cross-Servicing Project

 +5       ; This report assists users in reviewing all bills containing charges

 +6       ; with a distinct date of service on or after the co-payment exemption

 +7       ; effective date for Veterans with Primary or Secondary Eligibility equal

 +8       ; Pension

 +9       ;

 +10      ;  The report captures any charges without an IB status of cancelled, and

 +11      ; with an AR Status of Active, Open, Suspended, Write-Off, or Collected/

 +12      ; Closed or an IB Status of On-Hold, with a date of service on or after

 +13      ; the exemption effective date.

 +14      ;

MAIN      ; Initial Interactive Processing

 +1        NEW ZTQUEUED,ZTREQ

 +2        if $GET(U)=""

               SET U="^"

 +3        NEW STOPIT,EXCEL,RCSCR,ARTYPE,NDTFLAG

 +4        WRITE !!,"*** Print the Pension Exempt Charge Recon Report ***",!

 +5       ; quit flag

           SET STOPIT=0

 +6       ; Get Status

 +7       ;S ARTYPE=$$ARSTAT^RCDMCUT2(.STOPIT)

 +8        SET ARTYPE=$$ARSTAT(.STOPIT)

 +9        if STOPIT>0!(ARTYPE']"")

               QUIT

 +10      ;

 +11       SET NDTFLAG=0

 +12       Begin DoDot:1

 +13           NEW Y

 +14           KILL DIR,DIRUT,DTOUT,DIROUT,DUOUT

 +15           SET DIR(0)="Y"

               SET DIR("B")="NO"

               SET DIR("T")=DTIME

               WRITE !

 +16           SET DIR("A")="Show veterans with missing Exempt Date"

 +17           DO ^DIR

               SET NDTFLAG=$GET(Y)

 +18           if $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)

                   SET NDTFLAG="^"

 +19           KILL DIR,DIRUT,DTOUT,DIROUT,DUOUT,Y

           End DoDot:1

           if NDTFLAG="^"

               QUIT

 +20      ; Prompt user if report will be Excel Delimited format:

 +21       SET EXCEL=$$EXCEL^RCDMCUT2

 +22      ;Quit is user up arrowed or timed out

 +23       if EXCEL="^"

               QUIT

 +24       if EXCEL>0

               DO EXMSG^RCDMCUT2

 +25       if EXCEL'>0

               Begin DoDot:1

 +26               WRITE !!,"This report may take a while to process. It is recommended that"

 +27               WRITE !,"you Queue this report to a device that is 132 characters wide."

               End DoDot:1

 +28      ;

 +29       NEW %ZIS,ZTSK,ZTRTN,ZTIO,ZTDESC,POP,ZTSAVE

 +30       SET %ZIS="QM"

 +31       WRITE !

           DO ^%ZIS

 +32       IF POP

               SET STOPIT=1

               QUIT

 +33       SET RCSCR=$SELECT($EXTRACT($GET(IOST),1,2)="C-":1,1:0)

 +34      ;

 +35       IF $DATA(IO("Q"))

               Begin DoDot:1

 +36               SET ZTRTN="RUN^RCDMCR8A"

 +37               SET ZTIO=ION

 +38               SET ZTSAVE("RCSCR")=""

 +39               SET ZTSAVE("ARTYPE")=""

 +40               SET ZTSAVE("EXCEL")=""

 +41               SET ZTSAVE("NDTFLAG")=""

 +42               SET ZTDESC="Pension Exempt Charge Recon Report Process"

 +43               DO ^%ZTLOAD

 +44               WRITE !!,$SELECT($DATA(ZTSK):"Request Queued.  TASK = "_ZTSK,1:"REQUEST CANCELLED")

 +45               DO HOME^%ZIS

               End DoDot:1

               SET STOPIT=1

 +46      ;

 +47       if STOPIT>0!($DATA(ZTQUEUED))

               QUIT

 +48       DO RUN^RCDMCR8A

 +49       IF STOPIT'=2

               DO PAUSE2^RCDMCUT2

 +50       QUIT

 +51      ;

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        KILL ^TMP($JOB,"RCDMCR8")

 +5        SET RCPAGE=0

           SET STOPIT=$GET(STOPIT)

 +6       ; Collect the data in ^TMP

 +7        DO COLLECT^RCDMCR8B(.STOPIT,ARTYPE)

 +8        if $GET(STOPIT)>0

               QUIT

 +9        USE IO

 +10      ; Print Report using data in ^TMP

 +11       DO REPORT

 +12       IF 'RCSCR

               WRITE !,@IOF

 +13       DO ^%ZISC

 +14       KILL ^TMP($JOB,"RCDMCR8")

 +15       KILL EXCEL,RCSCR,TESTDATE

 +16       QUIT

 +17      ;

REPORT    ;Print report

 +1        NEW RUNDATE,STATUS,NAME,SSN,BILLNO,IBIEN,SKIP,DISCHDT

 +2       ;

 +3        SET RUNDATE=$$FMTE^XLFDT($$NOW^XLFDT,"9MP")

 +4        DO HDR

 +5        IF +$DATA(^TMP($JOB,"RCDMCR8"))'>0

               WRITE !,"No data meets the criteria."

               QUIT

 +6        KILL SKIP

 +7        SET NAME=""

 +8        FOR

               SET NAME=$ORDER(^TMP($JOB,"RCDMCR8","DETAIL",NAME))

               if NAME']""

                   QUIT

               Begin DoDot:1

 +9                SET SSN=""

 +10               FOR

                       SET SSN=$ORDER(^TMP($JOB,"RCDMCR8","DETAIL",NAME,SSN))

                       if SSN']""

                           QUIT

                       Begin DoDot:2

 +11                       SET BILLNO=""

 +12                       FOR

                               SET BILLNO=$ORDER(^TMP($JOB,"RCDMCR8","DETAIL",NAME,SSN,BILLNO))

                               if BILLNO']""

                                   QUIT

                               Begin DoDot:3

 +13                               SET IBIEN=""

 +14                               FOR

                                       SET IBIEN=$ORDER(^TMP($JOB,"RCDMCR8","DETAIL",NAME,SSN,BILLNO,IBIEN))

                                       if IBIEN']""

                                           QUIT

                                       Begin DoDot:4

 +15                                       NEW NODE,SERVDT,RXDT,ELIG,EXEMPTDT,RXNUM,RXNAM,STATUS,ELIGTYP,PNTERMDT

 +16      ; S ^TMP($J,"RCDMCR8","DETAIL",NAME,SSN,BILLNO,IBIEN)=SERVDT_U_RXDT_U_ELIG_U_EXEMPTDT_U_RXNUM_U_RXNAM_U_STATUS_U_ELIGTYP

 +17                                       SET NODE=$GET(^TMP($JOB,"RCDMCR8","DETAIL",NAME,SSN,BILLNO,IBIEN))

 +18                                       SET SERVDT=$SELECT($PIECE(NODE,U,10)'="":$PIECE(NODE,U,10),1:$PIECE(NODE,U,1))

 +19                                       SET RXDT=$PIECE(NODE,U,2)

 +20                                       SET ELIG=$PIECE(NODE,U,3)

 +21                                       SET EXEMPTDT=$PIECE(NODE,U,4)

 +22                                       SET RXNUM=$PIECE(NODE,U,5)

 +23                                       SET RXNAM=$PIECE(NODE,U,6)

 +24                                       SET STATUS=$PIECE(NODE,U,7)

 +25                                       SET ELIGTYP=$PIECE(NODE,U,8)

 +26      ;Pension Termination Date

                                           SET PNTERMDT=$PIECE(NODE,U,9)

 +27      ;Discharge Date

                                           SET DISCHDT=$PIECE(NODE,U,11)

 +28                                       IF EXCEL'>0

                                               DO WRLINE

                                               QUIT

 +29                                       IF EXCEL>0

                                               DO WRLINE2

                                               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

 +30       QUIT

 +31      ;

WRLINE    ; Write the data formated report line

 +1       ; Columns are - position, width, spacing (offset header by)

 +2       ;Veteran Name - 1,23,1

 +3       ;Pat/ID (1st char Last Name + Last 4 of SSN) - 25,5,2

 +4       ;Bill # - 32,11,1

 +5       ;EXMPTDT - 44,7,2

 +6       ;PNTERMDT - 53,7,3

 +7       ;Med Care Date - 63,7,1

 +8       ;D/C Date - 72,8,2

 +9       ;RXFillDT - 82,7,2

 +10      ;RX # - 91,9,1

 +11      ;RX Name - 101,22,1

 +12      ;Status - 124,9,1

 +13       DO CHKP()

           if STOPIT

               QUIT

 +14       IF NDTFLAG=0

               IF EXEMPTDT="NODATE"

                   QUIT

 +15       WRITE !

 +16      ; Veteran Name

           WRITE $EXTRACT(NAME,1,23)

 +17      ; 1st char last name + Last 4 of SSN

           WRITE ?24,$EXTRACT(NAME,1)_$EXTRACT(SSN,$LENGTH(SSN)-3,$LENGTH(SSN))

 +18      ; Bill Number

           WRITE ?31,$PIECE(BILLNO,"/",1)

 +19       IF EXEMPTDT="NODATE"

               WRITE ?43,EXEMPTDT

               QUIT

 +20       WRITE ?43,$$STRIP^XLFSTR($$FMTE^XLFDT(EXEMPTDT,"8D")," ")

 +21       if PNTERMDT>0

               WRITE ?52,$$STRIP^XLFSTR($$FMTE^XLFDT(PNTERMDT,"8D")," ")

 +22       if SERVDT>0

               WRITE ?62,$$STRIP^XLFSTR($$FMTE^XLFDT(SERVDT,"8D")," ")

 +23      ;Discharge Date

           if DISCHDT>0

               WRITE ?70,$$STRIP^XLFSTR($$FMTE^XLFDT(DISCHDT,"8D")," ")

 +24      ; Med Fill Date

           if RXDT>0

               WRITE ?80,$$STRIP^XLFSTR($$FMTE^XLFDT(RXDT,"8D")," ")

 +25      ; RX #

           WRITE ?89,RXNUM

 +26      ; RX Name

           WRITE ?99,$EXTRACT(RXNAM,1,22)

 +27       WRITE ?122,$EXTRACT(STATUS,1,9)

 +28      ;W:RXDT>0 ?71,$$STRIP^XLFSTR($$FMTE^XLFDT(RXDT,"8D")," ") ; Med Fill Date

 +29      ;W ?79,RXNUM ; RX #

 +30      ;W ?89,$E(RXNAM,1,22) ; RX Name

 +31      ;W ?112,$E(STATUS,1,9)

 +32      ;W ?122,$E(ELIGTYP,1,4)

 +33       QUIT

 +34      ;

WRLINE2   ; Write the Excel report line

 +1        IF NDTFLAG=0

               IF EXEMPTDT="NODATE"

                   QUIT

 +2        WRITE !

 +3        WRITE NAME,U

 +4        WRITE $EXTRACT(NAME,1)_$EXTRACT(SSN,$LENGTH(SSN)-3,$LENGTH(SSN)),U

 +5        WRITE $PIECE(BILLNO,"/",1),U

 +6        IF EXEMPTDT="NODATE"

               WRITE EXEMPTDT,U,U,U,U,U,U,U

               QUIT

 +7        if EXEMPTDT

               WRITE $$FMTE^XLFDT(EXEMPTDT,"9D")

           WRITE U

 +8        if PNTERMDT

               WRITE $$FMTE^XLFDT(PNTERMDT,"9D")

           WRITE U

 +9        if SERVDT

               WRITE $$FMTE^XLFDT(SERVDT,"9D")

           WRITE U

 +10       if DISCHDT

               WRITE $$FMTE^XLFDT(DISCHDT,"9D")

           WRITE U

 +11       if RXDT

               WRITE $$FMTE^XLFDT(RXDT,"9D")

           WRITE U

 +12       WRITE RXNUM,U

 +13       WRITE RXNAM,U

 +14       WRITE STATUS,U

 +15      ;W ELIGTYP,U

 +16       QUIT

 +17      ;

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

 +6       ;

HDR       ;Print Report Header

 +1        IF EXCEL>0

               Begin DoDot:1

 +2                WRITE !,"Veteran Name",U,"Pat/ID",U

 +3                WRITE "Bill #",U,"EXMPTDT",U,"PenTermDt",U,"Med Care Date",U,"D/C Date",U,"RXFillDT",U,"RX #",U,"RX Name",U,"Status"

               End DoDot:1

               QUIT

 +4        SET RCPAGE=RCPAGE+1

 +5        WRITE @IOF,"Pension Exempt Charge Reconciliation Report  -- Run Date: ",RUNDATE," --"

 +6        WRITE ?122,"Page "_RCPAGE

 +7       ;Print to screen or printer

 +8        WRITE !,"Veteran Name",?24,"Pat/ID",?31,"Bill #",?43,"EXMPTDT",?52,"PenTermDt",?62,"MedC DT",?70,"D/C Date",?80,"RXFillDT",?89,"RX #",?99,"RX Name",?122,"Status"

 +9        DO ULINE^RCDMCUT2("=",$GET(IOM))

 +10       QUIT

 +11      ;

ARSTAT(STOPIT) ;Chose AR status

 +1        NEW C,SL,J,TEMP

 +2        SET SL=0

 +3        FOR J=1:1:10

               Begin DoDot:1

 +4                SET SL=0

 +5                DO MENU

 +6                IF Y=7

                       QUIT

 +7                IF Y="^"!(Y="")

                       SET STOPIT=1

                       QUIT

 +8                IF $EXTRACT(Y,$LENGTH(Y))=","

                       SET Y=$EXTRACT(Y,1,$LENGTH(Y)-1)

 +9                FOR C=1:1:$LENGTH(Y,",")

                       if SL!(Y=7)

                           QUIT

                       Begin DoDot:2

 +10                       SET TEMP=$PIECE(Y,",",C)

 +11                       IF TEMP>7!(TEMP<1)

                               SET SL=1

                               QUIT

 +12                       IF TEMP=7

                               SET Y=7

                               QUIT

                       End DoDot:2

               End DoDot:1

               if SL=0

                   QUIT

 +13       QUIT Y

 +14      ;

MENU      ;

 +1        WRITE !,?5,"1 - Active"

 +2        WRITE !,?5,"2 - Open"

 +3        WRITE !,?5,"3 - Suspended"

 +4        WRITE !,?5,"4 - Collected/Closed"

 +5        WRITE !,?5,"5 - IB On-Hold"

 +6        WRITE !,?5,"6 - Write-Off"

 +7        WRITE !,?5,"7 - ALL (Includes 1-6 and AR CANCELLATIONS)",!

 +8        NEW DIR

 +9        KILL X,Y

 +10       SET DIR(0)="LO^1:7"

 +11       SET DIR("B")=7

 +12       DO ^DIR

 +13       QUIT

RCDMCR8A.m