- 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 Feb 18, 2025@23:10:04 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