RCDMCR6A ;ALB/YG - 50-100 Percent SC Exempt Charge Reconciliation Report - Input/output; Apr 9, 2019@21:06
;;4.5;Accounts Receivable;**347,386,414**;Mar 20, 1995;Build 2
;;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
; to 50 to 100% Service Connected
;
; 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.
;
;PRC*4.5*386 Uses admit date in lieu of discharge date for I/P
; Removes cancelled IB charges from report
; Removes Urgent Care copayments as they are not auto exempt
;
MAIN ; Initial Interactive Processing
S:$G(U)="" U="^"
;N STOPIT,EXCEL,RCSCR,RDDATE,RCBEGDT,RCENDDT,EOCBEGDT,EOCENDDT,EOCDATE,VLSDATE,VLSBEGDT,VLSENDDT,RPTTYPE
N STOPIT,EXCEL,RCSCR,ARTYPE
W !!,"*** Print the 50-100 Percent SC Exempt Charge Reconciliation Report ***",!
;
S STOPIT=0 ; quit flag
; Get Status
S ARTYPE=$$ARSTAT^RCDMCUT2(.STOPIT)
Q:STOPIT>0!(ARTYPE']"")
;
; 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^RCDMCR6A"
. S ZTIO=ION
. S ZTSAVE("RCSCR")=""
. S ZTSAVE("ARTYPE")=""
. S ZTSAVE("EXCEL")=""
. S ZTDESC="50-100 Percent SC Exempt Charge 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^RCDMCR6A
I STOPIT'=2 D PAUSE2^RCDMCUT2
Q
QUERPT ; Initial Taskman Scheduled Queued processing
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,"RCDMCR6")
S RCPAGE=0,STOPIT=$G(STOPIT)
; Collect the data in ^TMP
D COLLECT^RCDMCR6B(.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,"RCDMCR6")
K EXCEL,RCSCR,TESTDATE
Q
;
REPORT ;Print report
N RUNDATE,STATUS,NAME,SSN,BILLNO,IBIEN,SKIP,RCDADMIT,RCDEND,RCDIBRC1 ;PRCA*4.5*386
;
S RUNDATE=$$FMTE^XLFDT($$NOW^XLFDT,"9MP")
D HDR
I +$D(^TMP($J,"RCDMCR6"))'>0 W !,"No data meets the criteria." Q
K SKIP
S NAME=""
F S NAME=$O(^TMP($J,"RCDMCR6","DETAIL",NAME)) Q:NAME']"" D Q:STOPIT
. S SSN=""
. F S SSN=$O(^TMP($J,"RCDMCR6","DETAIL",NAME,SSN)) Q:SSN']"" D Q:STOPIT
. . S BILLNO=""
. . F S BILLNO=$O(^TMP($J,"RCDMCR6","DETAIL",NAME,SSN,BILLNO)) Q:BILLNO']"" D Q:STOPIT
. . . S IBIEN=""
. . . F S IBIEN=$O(^TMP($J,"RCDMCR6","DETAIL",NAME,SSN,BILLNO,IBIEN)),RCDEND=0 Q:IBIEN']"" D Q:STOPIT
. . . . N NODE,SERVDT,RXDT,ELIG,EXEMPTDT,RXNUM,RXNAM,STATUS
. . . . S NODE=$G(^TMP($J,"RCDMCR6","DETAIL",NAME,SSN,BILLNO,IBIEN))
. . . . S (RCDADMIT,RCDIBRC1)="" ;PRCA*4.5*386
. . . . S SERVDT=$P(NODE,U,1) D:BILLNO ;PRCA*4.5*386
. . . . . S RCDIEN=$O(^IB("ABIL",BILLNO,0)) Q:'RCDIEN
. . . . . S RCDIBREC=$G(^IB(RCDIEN,0)) Q:'RCDIBREC
. . . . . I $P(RCDIBREC,U,16) D ;PRCA*4.5*386
. . . . . . S RCDIBPNT=$P(RCDIBREC,U,16)
. . . . . . S RCDIBRC1=$G(^IB(RCDIBPNT,0)),RCDADMIT=""
. . . . . I ":10:11:"[(":"_$P(RCDIBREC,U,5)_":") S RCDEND=1 Q ;PRCA*4.5*386
. . . . . I +RCDIBRC1,":55:56:"[(":"_+$P(RCDIBRC1,U,3)_":") S RCDADMIT=$P(RCDIBRC1,U,17) ;PRCA*4.5*386
. . . . Q:RCDEND ;PRCA*4.5*386
. . . . S SERVDT=$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)
. . . . 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 - 0,23,1
;SSN - 24,10,1
;Eligibility - 35,11,1
;Bill # - 47,11,1
;EXMPTDT - 59,7,1
;Med Care Date - 67,13,1
;RXFillDT - 81,7,1
;RX # - 89,9,1
;RX Name - 99,22,1
;AR Status - 122,9
D CHKP() Q:STOPIT
W !
;If Multiple Bills for Vet only print Name & SSN for 1st record on page
; Disable skip for now (as per direction of customer) with :0
I (NAME_SSN)'=$G(SKIP(1)) D
. W $E(NAME,1,23) ; Veteran Name
. W ?24,SSN ; SSN
. S:0 SKIP(1)=NAME_SSN
W ?35,ELIG
W ?47,$P(BILLNO,"/",1) ; Bill Number
I EXEMPTDT="NODATE" W ?59,EXEMPTDT Q
W ?59,$$STRIP^XLFSTR($$FMTE^XLFDT(EXEMPTDT,"8D")," ")
I RCDADMIT S SERVDT=RCDADMIT ;PRCA*4.5*386
W:SERVDT>0 ?67,$$STRIP^XLFSTR($$FMTE^XLFDT(SERVDT,"8D")," ")
W:RXDT>0 ?81,$$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) ;PRCA*4.5*386
Q
;
WRLINE2 ; Write the Excel report line
W !
W NAME,U
W SSN,U
W ELIG,U
W $P(BILLNO,"/",1),U
I EXEMPTDT="NODATE" W EXEMPTDT Q
W:EXEMPTDT $$FMTE^XLFDT(EXEMPTDT,"9D") W U
I RCDADMIT S SERVDT=RCDADMIT ;PRCA*4.5*386
W:SERVDT $$FMTE^XLFDT(SERVDT,"9D") W U
W:RXDT $$FMTE^XLFDT(RXDT,"9D") W U
W RXNUM,U
W RXNAM,U
W STATUS,U
Q
;
CHKP(FOOTER) ;Check for End of Page
;INPUT:
; FOOTER - Footer value. Optional. Default to 4 if nothing passed
Q 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,"SSN",U,"Eligibility",U,"Bill #",U,"EXMPTDT",U,"Med Care Date",U,"RXFillDT",U,"RX #",U,"RX Name",U,"Status"
S RCPAGE=RCPAGE+1
W @IOF,"50-100 Percent SC Exempt Charge Reconciliation Report -- Run Date: ",RUNDATE," --"
W ?122,"Page "_RCPAGE
W !
;Print to screen or printer
W !,"Veteran Name",?24,"SSN",?35,"Eligibility",?47,"Bill #",?59,"EXMPTDT",?67,"Med Care Date",?81,"RXFillDT",?90,"RX #",?99,"RX Name",?122,"Status"
D ULINE^RCDMCUT2("=",$G(IOM))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDMCR6A 6591 printed Nov 22, 2024@16:53:51 Page 2
RCDMCR6A ;ALB/YG - 50-100 Percent SC Exempt Charge Reconciliation Report - Input/output; Apr 9, 2019@21:06
+1 ;;4.5;Accounts Receivable;**347,386,414**;Mar 20, 1995;Build 2
+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 ; to 50 to 100% Service Connected
+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 ;
+15 ;PRC*4.5*386 Uses admit date in lieu of discharge date for I/P
+16 ; Removes cancelled IB charges from report
+17 ; Removes Urgent Care copayments as they are not auto exempt
+18 ;
MAIN ; Initial Interactive Processing
+1 if $GET(U)=""
SET U="^"
+2 ;N STOPIT,EXCEL,RCSCR,RDDATE,RCBEGDT,RCENDDT,EOCBEGDT,EOCENDDT,EOCDATE,VLSDATE,VLSBEGDT,VLSENDDT,RPTTYPE
+3 NEW STOPIT,EXCEL,RCSCR,ARTYPE
+4 WRITE !!,"*** Print the 50-100 Percent SC Exempt Charge Reconciliation Report ***",!
+5 ;
+6 ; quit flag
SET STOPIT=0
+7 ; Get Status
+8 SET ARTYPE=$$ARSTAT^RCDMCUT2(.STOPIT)
+9 if STOPIT>0!(ARTYPE']"")
QUIT
+10 ;
+11 ; Prompt user if report will be Excel Delimited format:
+12 SET EXCEL=$$EXCEL^RCDMCUT2
+13 ;Quit is user up arrowed or timed out
+14 if EXCEL="^"
QUIT
+15 if EXCEL>0
DO EXMSG^RCDMCUT2
+16 if EXCEL'>0
Begin DoDot:1
+17 WRITE !!,"This report may take a while to process. It is recommended that"
+18 WRITE !,"you Queue this report to a device that is 132 characters wide."
End DoDot:1
+19 ;
+20 NEW %ZIS,ZTSK,ZTRTN,ZTIO,ZTDESC,POP,ZTSAVE
+21 SET %ZIS="QM"
+22 WRITE !
DO ^%ZIS
+23 IF POP
SET STOPIT=1
QUIT
+24 SET RCSCR=$SELECT($EXTRACT($GET(IOST),1,2)="C-":1,1:0)
+25 ;
+26 IF $DATA(IO("Q"))
Begin DoDot:1
+27 SET ZTRTN="RUN^RCDMCR6A"
+28 SET ZTIO=ION
+29 SET ZTSAVE("RCSCR")=""
+30 SET ZTSAVE("ARTYPE")=""
+31 SET ZTSAVE("EXCEL")=""
+32 SET ZTDESC="50-100 Percent SC Exempt Charge Reconciliation Report Process"
+33 DO ^%ZTLOAD
+34 WRITE !!,$SELECT($DATA(ZTSK):"Request Queued. TASK = "_ZTSK,1:"REQUEST CANCELLED")
+35 DO HOME^%ZIS
End DoDot:1
SET STOPIT=1
+36 ;
+37 if STOPIT>0!($DATA(ZTQUEUED))
QUIT
+38 DO RUN^RCDMCR6A
+39 IF STOPIT'=2
DO PAUSE2^RCDMCUT2
+40 QUIT
QUERPT ; Initial Taskman Scheduled Queued processing
+1 QUIT
+2 ;
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,"RCDMCR6")
+5 SET RCPAGE=0
SET STOPIT=$GET(STOPIT)
+6 ; Collect the data in ^TMP
+7 DO COLLECT^RCDMCR6B(.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,"RCDMCR6")
+15 KILL EXCEL,RCSCR,TESTDATE
+16 QUIT
+17 ;
REPORT ;Print report
+1 ;PRCA*4.5*386
NEW RUNDATE,STATUS,NAME,SSN,BILLNO,IBIEN,SKIP,RCDADMIT,RCDEND,RCDIBRC1
+2 ;
+3 SET RUNDATE=$$FMTE^XLFDT($$NOW^XLFDT,"9MP")
+4 DO HDR
+5 IF +$DATA(^TMP($JOB,"RCDMCR6"))'>0
WRITE !,"No data meets the criteria."
QUIT
+6 KILL SKIP
+7 SET NAME=""
+8 FOR
SET NAME=$ORDER(^TMP($JOB,"RCDMCR6","DETAIL",NAME))
if NAME']""
QUIT
Begin DoDot:1
+9 SET SSN=""
+10 FOR
SET SSN=$ORDER(^TMP($JOB,"RCDMCR6","DETAIL",NAME,SSN))
if SSN']""
QUIT
Begin DoDot:2
+11 SET BILLNO=""
+12 FOR
SET BILLNO=$ORDER(^TMP($JOB,"RCDMCR6","DETAIL",NAME,SSN,BILLNO))
if BILLNO']""
QUIT
Begin DoDot:3
+13 SET IBIEN=""
+14 FOR
SET IBIEN=$ORDER(^TMP($JOB,"RCDMCR6","DETAIL",NAME,SSN,BILLNO,IBIEN))
SET RCDEND=0
if IBIEN']""
QUIT
Begin DoDot:4
+15 NEW NODE,SERVDT,RXDT,ELIG,EXEMPTDT,RXNUM,RXNAM,STATUS
+16 SET NODE=$GET(^TMP($JOB,"RCDMCR6","DETAIL",NAME,SSN,BILLNO,IBIEN))
+17 ;PRCA*4.5*386
SET (RCDADMIT,RCDIBRC1)=""
+18 ;PRCA*4.5*386
SET SERVDT=$PIECE(NODE,U,1)
if BILLNO
Begin DoDot:5
+19 SET RCDIEN=$ORDER(^IB("ABIL",BILLNO,0))
if 'RCDIEN
QUIT
+20 SET RCDIBREC=$GET(^IB(RCDIEN,0))
if 'RCDIBREC
QUIT
+21 ;PRCA*4.5*386
IF $PIECE(RCDIBREC,U,16)
Begin DoDot:6
+22 SET RCDIBPNT=$PIECE(RCDIBREC,U,16)
+23 SET RCDIBRC1=$GET(^IB(RCDIBPNT,0))
SET RCDADMIT=""
End DoDot:6
+24 ;PRCA*4.5*386
IF ":10:11:"[(":"_$PIECE(RCDIBREC,U,5)_":")
SET RCDEND=1
QUIT
+25 ;PRCA*4.5*386
IF +RCDIBRC1
IF ":55:56:"[(":"_+$PIECE(RCDIBRC1,U,3)_":")
SET RCDADMIT=$PIECE(RCDIBRC1,U,17)
End DoDot:5
+26 ;PRCA*4.5*386
if RCDEND
QUIT
+27 SET SERVDT=$PIECE(NODE,U,1)
+28 SET RXDT=$PIECE(NODE,U,2)
+29 SET ELIG=$PIECE(NODE,U,3)
+30 SET EXEMPTDT=$PIECE(NODE,U,4)
+31 SET RXNUM=$PIECE(NODE,U,5)
+32 SET RXNAM=$PIECE(NODE,U,6)
+33 SET STATUS=$PIECE(NODE,U,7)
+34 IF EXCEL'>0
DO WRLINE
QUIT
+35 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
+36 QUIT
+37 ;
WRLINE ; Write the data formated report line
+1 ; Columns are - position, width, spacing (offset header by)
+2 ;Veteran Name - 0,23,1
+3 ;SSN - 24,10,1
+4 ;Eligibility - 35,11,1
+5 ;Bill # - 47,11,1
+6 ;EXMPTDT - 59,7,1
+7 ;Med Care Date - 67,13,1
+8 ;RXFillDT - 81,7,1
+9 ;RX # - 89,9,1
+10 ;RX Name - 99,22,1
+11 ;AR Status - 122,9
+12 DO CHKP()
if STOPIT
QUIT
+13 WRITE !
+14 ;If Multiple Bills for Vet only print Name & SSN for 1st record on page
+15 ; Disable skip for now (as per direction of customer) with :0
+16 IF (NAME_SSN)'=$GET(SKIP(1))
Begin DoDot:1
+17 ; Veteran Name
WRITE $EXTRACT(NAME,1,23)
+18 ; SSN
WRITE ?24,SSN
+19 if 0
SET SKIP(1)=NAME_SSN
End DoDot:1
+20 WRITE ?35,ELIG
+21 ; Bill Number
WRITE ?47,$PIECE(BILLNO,"/",1)
+22 IF EXEMPTDT="NODATE"
WRITE ?59,EXEMPTDT
QUIT
+23 WRITE ?59,$$STRIP^XLFSTR($$FMTE^XLFDT(EXEMPTDT,"8D")," ")
+24 ;PRCA*4.5*386
IF RCDADMIT
SET SERVDT=RCDADMIT
+25 if SERVDT>0
WRITE ?67,$$STRIP^XLFSTR($$FMTE^XLFDT(SERVDT,"8D")," ")
+26 ; Med Fill Date
if RXDT>0
WRITE ?81,$$STRIP^XLFSTR($$FMTE^XLFDT(RXDT,"8D")," ")
+27 ; RX #
WRITE ?89,RXNUM
+28 ; RX Name
WRITE ?99,$EXTRACT(RXNAM,1,22)
+29 ;PRCA*4.5*386
WRITE ?122,$EXTRACT(STATUS,1,9)
+30 QUIT
+31 ;
WRLINE2 ; Write the Excel report line
+1 WRITE !
+2 WRITE NAME,U
+3 WRITE SSN,U
+4 WRITE ELIG,U
+5 WRITE $PIECE(BILLNO,"/",1),U
+6 IF EXEMPTDT="NODATE"
WRITE EXEMPTDT
QUIT
+7 if EXEMPTDT
WRITE $$FMTE^XLFDT(EXEMPTDT,"9D")
WRITE U
+8 ;PRCA*4.5*386
IF RCDADMIT
SET SERVDT=RCDADMIT
+9 if SERVDT
WRITE $$FMTE^XLFDT(SERVDT,"9D")
WRITE U
+10 if RXDT
WRITE $$FMTE^XLFDT(RXDT,"9D")
WRITE U
+11 WRITE RXNUM,U
+12 WRITE RXNAM,U
+13 WRITE STATUS,U
+14 QUIT
+15 ;
CHKP(FOOTER) ;Check for End of Page
+1 ;INPUT:
+2 ; FOOTER - Footer value. Optional. Default to 4 if nothing passed
+3 QUIT
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,"SSN",U,"Eligibility",U,"Bill #",U,"EXMPTDT",U,"Med Care Date",U,"RXFillDT",U,"RX #",U,"RX Name",U,"Status"
End DoDot:1
QUIT
+3 SET RCPAGE=RCPAGE+1
+4 WRITE @IOF,"50-100 Percent SC Exempt Charge Reconciliation Report -- Run Date: ",RUNDATE," --"
+5 WRITE ?122,"Page "_RCPAGE
+6 WRITE !
+7 ;Print to screen or printer
+8 WRITE !,"Veteran Name",?24,"SSN",?35,"Eligibility",?47,"Bill #",?59,"EXMPTDT",?67,"Med Care Date",?81,"RXFillDT",?90,"RX #",?99,"RX Name",?122,"Status"
+9 DO ULINE^RCDMCUT2("=",$GET(IOM))
+10 QUIT
