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
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
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
Q
;
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
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)
Q
;
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
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
;
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))
Q
;
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
;
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
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDMCR8A 7187 printed Nov 22, 2024@16:53:55 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 ;
+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
