RCDMCR7A ;ALB/YG - 10-40% SC Medical Care Copayment Exempt Charge Reconciliation Report - Input/output; Apr 9, 2019@21:06
;;4.5;Accounts Receivable;**347,386,414**;Jan 29, 2019;Build 2
;;Per VA Directive 6402, this routine should not be modified.
;
;This routine is being implemented for the AR Cross-Servicing Project
;It assists users in reviewing all medical care copayment bills
; containing charges with a distinct date of service on or after the
; copayment exemption effective date for Veterans with SC Percent equal
; to 10 to 40% and does not show prescription copayment bills.
;
; The report captures any medical care copayment charge 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 10-40% SC Medical Care Copayment Exempt Charge Recon 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 EXMSG^RCDMCUT2
D:'EXCEL
. 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^RCDMCR7A"
. S ZTIO=ION
. S ZTSAVE("RCSCR")=""
. S ZTSAVE("ARTYPE")=""
. S ZTSAVE("EXCEL")=""
. S ZTSAVE("STOPIT")=""
. S ZTDESC="50-100 Percent SC, A&A, Pension 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^RCDMCR7A
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,"RCDMCR7")
S RCPAGE=0,STOPIT=$G(STOPIT)
; Collect the data in ^TMP
D COLLECT^RCDMCR7B(.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,"RCDMCR7")
K EXCEL,RCSCR,TESTDATE
Q
;
REPORT ;Print report
N RUNDATE,STATUS,NAME,SSN,BILLNO,IBIEN,SKIP,SCPER,RCDIEN,RCDIBREC,RCDIBPNT,RCDEND,RCDADMIT,RCDIBRC1 ;PRCA*4.5*386
;
S RUNDATE=$$FMTE^XLFDT($$NOW^XLFDT,"9MP")
D HDR
I +$D(^TMP($J,"RCDMCR7"))'>0 W !,"No data meets the criteria." Q
K SKIP
S NAME=""
F S NAME=$O(^TMP($J,"RCDMCR7","DETAIL",NAME)) Q:NAME']"" D Q:STOPIT
. S SSN=""
. F S SSN=$O(^TMP($J,"RCDMCR7","DETAIL",NAME,SSN)) Q:SSN']"" D Q:STOPIT
. . S BILLNO=""
. . F S BILLNO=$O(^TMP($J,"RCDMCR7","DETAIL",NAME,SSN,BILLNO)) Q:BILLNO']"" D Q:STOPIT
. . . S IBIEN=""
. . . F S IBIEN=$O(^TMP($J,"RCDMCR7","DETAIL",NAME,SSN,BILLNO,IBIEN)),RCDEND=0 Q:IBIEN']"" D Q:STOPIT
. . . . N NODE,SERVDT,ELIG,EXEMPTDT,RXNUM,RXNAM,STATUS,RCDIEN,RCDIBREC,RCDIBPNT
. . . . ; S ^TMP($J,"RCDMCR7","DETAIL",NAME,SSN,BILLNO,IBIEN)=SERVDT_U_SCPER_U_EXEMPTDT_U_STATUS
. . . . S NODE=$G(^TMP($J,"RCDMCR7","DETAIL",NAME,SSN,BILLNO,IBIEN))
. . . . S (RCDADMIT,RCDIBRC1)=" " K RCDIBRC1 ;;PRCA*4.5*186
. . . . S SERVDT=$P(NODE,U,1) D:BILLNO Q:RCDEND ;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
. . . . . . S RCDIBPNT=$P(RCDIBREC,U,16)
. . . . . . S RCDIBRC1=$G(^IB(RCDIBPNT,0))
. . . . . . I ":10:11:"[(":"_$P(RCDIBREC,U,5)_":") S RCDEND=1 ;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 SCPER=$P(NODE,U,2)
. . . . S EXEMPTDT=$P(NODE,U,3)
. . . . S STATUS=$P(NODE,U,4)
. . . . 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
;SC Percent - 35,11,1
;Bill # - 47,11,1
;EXMPTDT - 59,7,1
;Med Care Date - 67,13,1
;Status - 81,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 ?38,SCPER,"%"
W ?47,$P(BILLNO,"/",1) ; Bill Number
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 ?81,$E(STATUS,1,9)
Q
;
WRLINE2 ; Write the Excel report line
W !
W NAME,U
W SSN,U
W SCPER,"%",U
W $P(BILLNO,"/",1),U
W $$FMTE^XLFDT(EXEMPTDT,"9D"),U
I RCDADMIT S SERVDT=RCDADMIT ;PRCA*4.5*386
W $$FMTE^XLFDT(SERVDT,"9D"),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,"SC Percent",U,"Bill #",U,"EXMPTDT",U,"Med Care Date",U,"Status"
S RCPAGE=RCPAGE+1
W @IOF,"10-40% SC Medical Care Copayment Exempt Charge Reconciliation Report -- Run Date: ",RUNDATE," --"
W ?122,"Page "_RCPAGE
W !
;Print to screen or printer
W !,"Veteran Name",?24,"SSN",?35,"SC Percent",?47,"Bill #",?59,"EXMPTDT",?67,"Med Care Date",?81,"Status"
D ULINE^RCDMCUT2("=",$G(IOM))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDMCR7A 6321 printed Apr 09, 2024@20:51:46 Page 2
RCDMCR7A ;ALB/YG - 10-40% SC Medical Care Copayment Exempt Charge Reconciliation Report - Input/output; Apr 9, 2019@21:06
+1 ;;4.5;Accounts Receivable;**347,386,414**;Jan 29, 2019;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 ;It assists users in reviewing all medical care copayment bills
+6 ; containing charges with a distinct date of service on or after the
+7 ; copayment exemption effective date for Veterans with SC Percent equal
+8 ; to 10 to 40% and does not show prescription copayment bills.
+9 ;
+10 ; The report captures any medical care copayment charge without an IB
+11 ; status of cancelled, and with an AR Status of Active, Open, Suspended
+12 ; Write-Off, or Collected/Closed OR an IB Status of On-Hold, with a date
+13 ; of service on or after 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 10-40% SC Medical Care Copayment Exempt Charge Recon 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
DO EXMSG^RCDMCUT2
+16 if 'EXCEL
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 NEW %ZIS,ZTSK,ZTRTN,ZTIO,ZTDESC,POP,ZTSAVE
+20 SET %ZIS="QM"
+21 WRITE !
DO ^%ZIS
+22 IF POP
SET STOPIT=1
QUIT
+23 SET RCSCR=$SELECT($EXTRACT($GET(IOST),1,2)="C-":1,1:0)
+24 ;
+25 IF $DATA(IO("Q"))
Begin DoDot:1
+26 SET ZTRTN="RUN^RCDMCR7A"
+27 SET ZTIO=ION
+28 SET ZTSAVE("RCSCR")=""
+29 SET ZTSAVE("ARTYPE")=""
+30 SET ZTSAVE("EXCEL")=""
+31 SET ZTSAVE("STOPIT")=""
+32 SET ZTDESC="50-100 Percent SC, A&A, Pension 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^RCDMCR7A
+39 IF STOPIT'=2
DO PAUSE2^RCDMCUT2
+40 QUIT
+41 ;
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,"RCDMCR7")
+5 SET RCPAGE=0
SET STOPIT=$GET(STOPIT)
+6 ; Collect the data in ^TMP
+7 DO COLLECT^RCDMCR7B(.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,"RCDMCR7")
+15 KILL EXCEL,RCSCR,TESTDATE
+16 QUIT
+17 ;
REPORT ;Print report
+1 ;PRCA*4.5*386
NEW RUNDATE,STATUS,NAME,SSN,BILLNO,IBIEN,SKIP,SCPER,RCDIEN,RCDIBREC,RCDIBPNT,RCDEND,RCDADMIT,RCDIBRC1
+2 ;
+3 SET RUNDATE=$$FMTE^XLFDT($$NOW^XLFDT,"9MP")
+4 DO HDR
+5 IF +$DATA(^TMP($JOB,"RCDMCR7"))'>0
WRITE !,"No data meets the criteria."
QUIT
+6 KILL SKIP
+7 SET NAME=""
+8 FOR
SET NAME=$ORDER(^TMP($JOB,"RCDMCR7","DETAIL",NAME))
if NAME']""
QUIT
Begin DoDot:1
+9 SET SSN=""
+10 FOR
SET SSN=$ORDER(^TMP($JOB,"RCDMCR7","DETAIL",NAME,SSN))
if SSN']""
QUIT
Begin DoDot:2
+11 SET BILLNO=""
+12 FOR
SET BILLNO=$ORDER(^TMP($JOB,"RCDMCR7","DETAIL",NAME,SSN,BILLNO))
if BILLNO']""
QUIT
Begin DoDot:3
+13 SET IBIEN=""
+14 FOR
SET IBIEN=$ORDER(^TMP($JOB,"RCDMCR7","DETAIL",NAME,SSN,BILLNO,IBIEN))
SET RCDEND=0
if IBIEN']""
QUIT
Begin DoDot:4
+15 NEW NODE,SERVDT,ELIG,EXEMPTDT,RXNUM,RXNAM,STATUS,RCDIEN,RCDIBREC,RCDIBPNT
+16 ; S ^TMP($J,"RCDMCR7","DETAIL",NAME,SSN,BILLNO,IBIEN)=SERVDT_U_SCPER_U_EXEMPTDT_U_STATUS
+17 SET NODE=$GET(^TMP($JOB,"RCDMCR7","DETAIL",NAME,SSN,BILLNO,IBIEN))
+18 ;;PRCA*4.5*186
SET (RCDADMIT,RCDIBRC1)=" "
KILL RCDIBRC1
+19 ;PRCA*4.5*386
SET SERVDT=$PIECE(NODE,U,1)
if BILLNO
Begin DoDot:5
+20 SET RCDIEN=$ORDER(^IB("ABIL",BILLNO,0))
if 'RCDIEN
QUIT
+21 SET RCDIBREC=$GET(^IB(RCDIEN,0))
if 'RCDIBREC
QUIT
+22 IF $PIECE(RCDIBREC,U,16)
Begin DoDot:6
+23 SET RCDIBPNT=$PIECE(RCDIBREC,U,16)
+24 SET RCDIBRC1=$GET(^IB(RCDIBPNT,0))
+25 ;PRCA*4.5*386
IF ":10:11:"[(":"_$PIECE(RCDIBREC,U,5)_":")
SET RCDEND=1
End DoDot:6
+26 ;PRCA*4.5*386
IF +RCDIBRC1
IF ":55:56:"[(":"_+$PIECE(RCDIBRC1,U,3)_":")
SET RCDADMIT=$PIECE(RCDIBRC1,U,17)
End DoDot:5
if RCDEND
QUIT
+27 ;PRCA*4.5*386
if RCDEND
QUIT
+28 SET SERVDT=$PIECE(NODE,U,1)
+29 SET SCPER=$PIECE(NODE,U,2)
+30 SET EXEMPTDT=$PIECE(NODE,U,3)
+31 SET STATUS=$PIECE(NODE,U,4)
+32 IF EXCEL'>0
DO WRLINE
QUIT
+33 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
+34 QUIT
+35 ;
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 ;SC Percent - 35,11,1
+5 ;Bill # - 47,11,1
+6 ;EXMPTDT - 59,7,1
+7 ;Med Care Date - 67,13,1
+8 ;Status - 81,9
+9 DO CHKP()
if STOPIT
QUIT
+10 WRITE !
+11 ;If Multiple Bills for Vet only print Name & SSN for 1st record on page
+12 ; Disable skip for now (as per direction of customer) with :0
+13 IF (NAME_SSN)'=$GET(SKIP(1))
Begin DoDot:1
+14 ; Veteran Name
WRITE $EXTRACT(NAME,1,23)
+15 ; SSN
WRITE ?24,SSN
+16 if 0
SET SKIP(1)=NAME_SSN
End DoDot:1
+17 WRITE ?38,SCPER,"%"
+18 ; Bill Number
WRITE ?47,$PIECE(BILLNO,"/",1)
+19 WRITE ?59,$$STRIP^XLFSTR($$FMTE^XLFDT(EXEMPTDT,"8D")," ")
+20 ;PRCA*4.5*386
IF RCDADMIT
SET SERVDT=RCDADMIT
+21 if SERVDT>0
WRITE ?67,$$STRIP^XLFSTR($$FMTE^XLFDT(SERVDT,"8D")," ")
+22 WRITE ?81,$EXTRACT(STATUS,1,9)
+23 QUIT
+24 ;
WRLINE2 ; Write the Excel report line
+1 WRITE !
+2 WRITE NAME,U
+3 WRITE SSN,U
+4 WRITE SCPER,"%",U
+5 WRITE $PIECE(BILLNO,"/",1),U
+6 WRITE $$FMTE^XLFDT(EXEMPTDT,"9D"),U
+7 ;PRCA*4.5*386
IF RCDADMIT
SET SERVDT=RCDADMIT
+8 WRITE $$FMTE^XLFDT(SERVDT,"9D"),U
+9 WRITE STATUS,U
+10 QUIT
+11 ;
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,"SC Percent",U,"Bill #",U,"EXMPTDT",U,"Med Care Date",U,"Status"
End DoDot:1
QUIT
+3 SET RCPAGE=RCPAGE+1
+4 WRITE @IOF,"10-40% SC Medical Care Copayment 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,"SC Percent",?47,"Bill #",?59,"EXMPTDT",?67,"Med Care Date",?81,"Status"
+9 DO ULINE^RCDMCUT2("=",$GET(IOM))
+10 QUIT
