Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCDMCR7A

RCDMCR7A.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;This routine is being implemented for the AR Cross-Servicing Project
  1. ;It assists users in reviewing all medical care copayment bills
  1. ; containing charges with a distinct date of service on or after the
  1. ; copayment exemption effective date for Veterans with SC Percent equal
  1. ; to 10 to 40% and does not show prescription copayment bills.
  1. ;
  1. ; The report captures any medical care copayment charge without an IB
  1. ; status of cancelled, and with an AR Status of Active, Open, Suspended
  1. ; Write-Off, or Collected/Closed OR an IB Status of On-Hold, with a date
  1. ; of service on or after the exemption effective date.
  1. ;
  1. ;PRC*4.5*386 Uses admit date in lieu of discharge date for I/P
  1. ; Removes cancelled IB charges from report
  1. ; Removes Urgent Care copayments as they are not auto exempt
  1. ;
  1. MAIN ; Initial Interactive Processing
  1. S:$G(U)="" U="^"
  1. ;N STOPIT,EXCEL,RCSCR,RDDATE,RCBEGDT,RCENDDT,EOCBEGDT,EOCENDDT,EOCDATE,VLSDATE,VLSBEGDT,VLSENDDT,RPTTYPE
  1. N STOPIT,EXCEL,RCSCR,ARTYPE
  1. W !!,"*** Print the 10-40% SC Medical Care Copayment Exempt Charge Recon Report ***",!
  1. ;
  1. S STOPIT=0 ; quit flag
  1. ; Get Status
  1. S ARTYPE=$$ARSTAT^RCDMCUT2(.STOPIT)
  1. Q:STOPIT>0!(ARTYPE']"")
  1. ;
  1. ; Prompt user if report will be Excel Delimited format:
  1. S EXCEL=$$EXCEL^RCDMCUT2
  1. ;Quit is user up arrowed or timed out
  1. Q:EXCEL="^"
  1. D:EXCEL EXMSG^RCDMCUT2
  1. D:'EXCEL
  1. . W !!,"This report may take a while to process. It is recommended that"
  1. . W !,"you Queue this report to a device that is 132 characters wide."
  1. N %ZIS,ZTSK,ZTRTN,ZTIO,ZTDESC,POP,ZTSAVE
  1. S %ZIS="QM"
  1. W ! D ^%ZIS
  1. I POP S STOPIT=1 Q
  1. S RCSCR=$S($E($G(IOST),1,2)="C-":1,1:0)
  1. ;
  1. I $D(IO("Q")) D S STOPIT=1
  1. . S ZTRTN="RUN^RCDMCR7A"
  1. . S ZTIO=ION
  1. . S ZTSAVE("RCSCR")=""
  1. . S ZTSAVE("ARTYPE")=""
  1. . S ZTSAVE("EXCEL")=""
  1. . S ZTSAVE("STOPIT")=""
  1. . S ZTDESC="50-100 Percent SC, A&A, Pension Exempt Charge Reconciliation Report Process"
  1. . D ^%ZTLOAD
  1. . W !!,$S($D(ZTSK):"Request Queued. TASK = "_ZTSK,1:"REQUEST CANCELLED")
  1. . D HOME^%ZIS
  1. ;
  1. Q:STOPIT>0!($D(ZTQUEUED))
  1. D RUN^RCDMCR7A
  1. I STOPIT'=2 D PAUSE2^RCDMCUT2
  1. Q
  1. ;
  1. QUERPT ; Initial Taskman Scheduled Queued processing
  1. Q
  1. ;
  1. RUN ;Get data and Print it out
  1. ;If queued ensure you delete it from the TASKS file
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. N RCPAGE
  1. K ^TMP($J,"RCDMCR7")
  1. S RCPAGE=0,STOPIT=$G(STOPIT)
  1. ; Collect the data in ^TMP
  1. D COLLECT^RCDMCR7B(.STOPIT,ARTYPE)
  1. Q:$G(STOPIT)>0
  1. U IO
  1. ; Print Report using data in ^TMP
  1. D REPORT
  1. I 'RCSCR W !,@IOF
  1. D ^%ZISC
  1. K ^TMP($J,"RCDMCR7")
  1. K EXCEL,RCSCR,TESTDATE
  1. Q
  1. ;
  1. REPORT ;Print report
  1. N RUNDATE,STATUS,NAME,SSN,BILLNO,IBIEN,SKIP,SCPER,RCDIEN,RCDIBREC,RCDIBPNT,RCDEND,RCDADMIT,RCDIBRC1 ;PRCA*4.5*386
  1. ;
  1. S RUNDATE=$$FMTE^XLFDT($$NOW^XLFDT,"9MP")
  1. D HDR
  1. I +$D(^TMP($J,"RCDMCR7"))'>0 W !,"No data meets the criteria." Q
  1. K SKIP
  1. S NAME=""
  1. F S NAME=$O(^TMP($J,"RCDMCR7","DETAIL",NAME)) Q:NAME']"" D Q:STOPIT
  1. . S SSN=""
  1. . F S SSN=$O(^TMP($J,"RCDMCR7","DETAIL",NAME,SSN)) Q:SSN']"" D Q:STOPIT
  1. . . S BILLNO=""
  1. . . F S BILLNO=$O(^TMP($J,"RCDMCR7","DETAIL",NAME,SSN,BILLNO)) Q:BILLNO']"" D Q:STOPIT
  1. . . . S IBIEN=""
  1. . . . F S IBIEN=$O(^TMP($J,"RCDMCR7","DETAIL",NAME,SSN,BILLNO,IBIEN)),RCDEND=0 Q:IBIEN']"" D Q:STOPIT
  1. . . . . N NODE,SERVDT,ELIG,EXEMPTDT,RXNUM,RXNAM,STATUS,RCDIEN,RCDIBREC,RCDIBPNT
  1. . . . . ; S ^TMP($J,"RCDMCR7","DETAIL",NAME,SSN,BILLNO,IBIEN)=SERVDT_U_SCPER_U_EXEMPTDT_U_STATUS
  1. . . . . S NODE=$G(^TMP($J,"RCDMCR7","DETAIL",NAME,SSN,BILLNO,IBIEN))
  1. . . . . S (RCDADMIT,RCDIBRC1)=" " K RCDIBRC1 ;;PRCA*4.5*186
  1. . . . . S SERVDT=$P(NODE,U,1) D:BILLNO Q:RCDEND ;PRCA*4.5*386
  1. . . . . . S RCDIEN=$O(^IB("ABIL",BILLNO,0)) Q:'RCDIEN
  1. . . . . . S RCDIBREC=$G(^IB(RCDIEN,0)) Q:'RCDIBREC
  1. . . . . . I $P(RCDIBREC,U,16) D
  1. . . . . . . S RCDIBPNT=$P(RCDIBREC,U,16)
  1. . . . . . . S RCDIBRC1=$G(^IB(RCDIBPNT,0))
  1. . . . . . . I ":10:11:"[(":"_$P(RCDIBREC,U,5)_":") S RCDEND=1 ;PRCA*4.5*386
  1. . . . . . I +RCDIBRC1,":55:56:"[(":"_+$P(RCDIBRC1,U,3)_":") S RCDADMIT=$P(RCDIBRC1,U,17) ;PRCA*4.5*386
  1. . . . . Q:RCDEND ;PRCA*4.5*386
  1. . . . . S SERVDT=$P(NODE,U,1)
  1. . . . . S SCPER=$P(NODE,U,2)
  1. . . . . S EXEMPTDT=$P(NODE,U,3)
  1. . . . . S STATUS=$P(NODE,U,4)
  1. . . . . I EXCEL'>0 D WRLINE Q
  1. . . . . I EXCEL>0 D WRLINE2 Q
  1. Q
  1. ;
  1. WRLINE ; Write the data formated report line
  1. ; Columns are - position, width, spacing (offset header by)
  1. ;Veteran Name - 0,23,1
  1. ;SSN - 24,10,1
  1. ;SC Percent - 35,11,1
  1. ;Bill # - 47,11,1
  1. ;EXMPTDT - 59,7,1
  1. ;Med Care Date - 67,13,1
  1. ;Status - 81,9
  1. D CHKP() Q:STOPIT
  1. W !
  1. ;If Multiple Bills for Vet only print Name & SSN for 1st record on page
  1. ; Disable skip for now (as per direction of customer) with :0
  1. I (NAME_SSN)'=$G(SKIP(1)) D
  1. . W $E(NAME,1,23) ; Veteran Name
  1. . W ?24,SSN ; SSN
  1. . S:0 SKIP(1)=NAME_SSN
  1. W ?38,SCPER,"%"
  1. W ?47,$P(BILLNO,"/",1) ; Bill Number
  1. W ?59,$$STRIP^XLFSTR($$FMTE^XLFDT(EXEMPTDT,"8D")," ")
  1. I RCDADMIT S SERVDT=RCDADMIT ;PRCA*4.5*386
  1. W:SERVDT>0 ?67,$$STRIP^XLFSTR($$FMTE^XLFDT(SERVDT,"8D")," ")
  1. W ?81,$E(STATUS,1,9)
  1. Q
  1. ;
  1. WRLINE2 ; Write the Excel report line
  1. W !
  1. W NAME,U
  1. W SSN,U
  1. W SCPER,"%",U
  1. W $P(BILLNO,"/",1),U
  1. W $$FMTE^XLFDT(EXEMPTDT,"9D"),U
  1. I RCDADMIT S SERVDT=RCDADMIT ;PRCA*4.5*386
  1. W $$FMTE^XLFDT(SERVDT,"9D"),U
  1. W STATUS,U
  1. Q
  1. ;
  1. CHKP(FOOTER) ;Check for End of Page
  1. ;INPUT:
  1. ; FOOTER - Footer value. Optional. Default to 4 if nothing passed
  1. Q I $G(FOOTER)'>0 S FOOTER=4
  1. I $Y>(IOSL-FOOTER) D:RCSCR PAUSE^RCDMCUT2 Q:STOPIT D HDR K SKIP
  1. Q
  1. ;
  1. HDR ;Print Report Header
  1. I EXCEL>0 D Q
  1. . W !,"Veteran Name",U,"SSN",U,"SC Percent",U,"Bill #",U,"EXMPTDT",U,"Med Care Date",U,"Status"
  1. S RCPAGE=RCPAGE+1
  1. W @IOF,"10-40% SC Medical Care Copayment Exempt Charge Reconciliation Report -- Run Date: ",RUNDATE," --"
  1. W ?122,"Page "_RCPAGE
  1. W !
  1. ;Print to screen or printer
  1. W !,"Veteran Name",?24,"SSN",?35,"SC Percent",?47,"Bill #",?59,"EXMPTDT",?67,"Med Care Date",?81,"Status"
  1. D ULINE^RCDMCUT2("=",$G(IOM))
  1. Q