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

PRCACDRP.m

Go to the documentation of this file. 
  1. PRCACDRP ;ALB/YG - Catastrophically Disabled Exempt Copay Charge Report; July 25, 2019@21:06
  1.  ;;4.5;Accounts Receivable;**350,386,414**;Mar 20, 1995;Build 2
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; Routine was cloned from IBOCDRPT and moved to AR (PRCA) namespace
  1.  ;
  1.  ;PRC*4.5*386 Uses admit date in lieu of discharge date for I/P
  1.  ;            Removes Urgent Care copayments as they are not auto exempt
  1.  ;
  1. EN ; - this will produce a report of patient's with charges that are CD.
  1.  ;
  1.  N POP,%ZIS,ZTRTN,ZTDESC,ZTSK,IBEDT,IBBDT,%DT,ZTSAVE,IBEXCEL
  1.  W !!,"*** Print the Catastrophically Disabled Exempt Copay Charge Report ***"
  1.  W !!,"The Catastrophically Disabled legislation effective date is May 5, 2010."
  1.  W !,"You should not enter a date prior to that date, any date entered before"
  1.  W !,"that will be automatically changed to May 5, 2010."
  1.  W !!,"This report includes bills for charges without an IB Status of Cancelled"
  1.  W !,"and with an AR Status of Active, Open, Suspended, Write-Off, Cancellation,"
  1.  W !,"Collected/Closed or with an IB Status of On-Hold, and an episode of care"
  1.  W !,"date on or after the Catastrophically Disabled exemption effective date.",!
  1.  D DATE Q:'IBEDT
  1.  S IBEXCEL=$$EXCEL^PRCACDRP()
  1.  I IBEXCEL D EXMSG
  1.  I 'IBEXCEL D
  1.  . W !!,"This report may take a while to process. It is recommended that you Queue"
  1.  . W !,"this report to a device that is 132 characters wide."
  1.  S %ZIS="QM" D ^%ZIS Q:POP
  1.  I $D(IO("Q")) D  Q
  1.  .S ZTRTN="DQ^PRCACDRP",ZTDESC="Catastrophically Disabled Copay Report"
  1.  .S ZTSAVE("IBEDT")="",ZTSAVE("IBBDT")="",ZTSAVE("IBEXCEL")=""
  1.  .D ^%ZTLOAD D HOME^%ZIS K IO("Q")
  1.  .D MES^XPDUTL("Catastrophically Disabled Copay Report queued #"_ZTSK)
  1. DQ U IO
  1.  ;
  1.  N IBX,IBZ,IBDT,IBDG,DFN,IBP,IBARX,IBARBILL,IBARDATA,IBDPT,IBDDT,IBQUIT,REAS,ARSTAT,EOCDT,FUND,IBDATA,IBSTAT,MCDT,RXDT,PRGRP,CD,CDDATE,PAR,PARZ
  1.  N PRCAAR1,PRCAADMT   ;PRCA*4.5*386
  1.  ;
  1.  S (IBP,IBQUIT)=0
  1.  D HEAD
  1.  I IBBDT<3100505 S IBBDT=3100505 ; not before CD effective date
  1.  S IBDDT=IBBDT-1 F  S IBDDT=$O(^IB("D",IBDDT)) Q:'IBDDT!(IBQUIT)  D  Q:IBQUIT
  1.  . S IBX=0 F  S IBX=$O(^IB("D",IBDDT,IBX)) Q:'IBX!(IBQUIT)  D  Q:IBQUIT
  1.  . . S IBZ=$G(^IB(IBX,0)),DFN=+$P(IBZ,"^",2),PRCAAR1=IBX,(PRCAADMT,PRCAAR1)=""   ;PRCA*4.5*386
  1.  . . I $P(IBZ,U,16) D   ;PRCA*4.5*386
  1.  . . . S PRCAAR1=$G(^IB($P(IBZ,U,16),0))
  1.  . . I +PRCAAR1,":55:56:"[(":"_+$P(PRCAAR1,U,3)_":") S PRCAADMT=$P(PRCAAR1,U,17)   ;PRCA*4.5*386
  1.  . . S PRGRP=$$PRIORITY^DGENA(DFN)
  1.  . . S IBDT=$S($E($P(IBZ,"^",4),1,2)=52:IBDDT,$P(IBZ,"^",8)="RX COPAYMENT":IBDDT,$P(IBZ,"^",15):$P(IBZ,"^",15),1:$P(IBZ,"^",14))\1 S:PRCAADMT IBDT=PRCAADMT
  1.  . . K IBDG
  1.  . . S IBDG=$$GET^DGENCDA(DFN,.IBDG)  ; IA# 4969
  1.  . . ; quit if no date, or pt not CD
  1.  . . S REAS=1
  1.  . . I 'IBDT Q  ; no date
  1.  . . S CDDATE=IBDG("REVDTE")
  1.  . . S CD=$G(IBDG("VCD"))="Y"
  1.  . . ; Business decision is to ignore Billing Exemption file 354.1
  1.  . . ;I 'CD S CDDATE="" F  S CD=$O(^IBA(354.1,"AP",DFN,CD)) Q:'CD  I $P($G(^IBA(354.1,CD,0)),U,5)=12 S CD=1,CDDATE=$P(^(0),U) Q
  1.  . . I 'CD Q
  1.  . . S IBARX=+$O(^PRCA(430,"B",$S($P(IBZ,"^",11):$P(IBZ,"^",11),1:0),0))  ; IA# 389
  1.  . . S IBARBILL=$S(IBARX:$$BILL^RCJIBFN2(IBARX),1:"")  ; IA# 1452
  1.  . . K IBARDATA
  1.  . . I IBARX D DIQ^RCJIBFN2(IBARX,"8,77:79;141;203;255.1","IBARDATA") ; IA# 1452
  1.  . . S IBDATA=$$GETIB^RCDMCR4B(IBX,0) I +IBDATA=0 Q  ; PRCA*4.5*414
  1.  . . S MCDT=$P(IBDATA,U,2) S:MCDT="" MCDT=$P(IBDATA,U,3)
  1.  . . S RXDT=$P(IBDATA,U,4)
  1.  . . S EOCDT=$S(RXDT>MCDT:RXDT,1:MCDT)
  1.  . . S IBSTAT=$P(IBDATA,U,5) S:IBSTAT="" IBSTAT=$P(IBZ,U,5)
  1.  . . S ARSTAT=$G(IBARDATA(430,IBARX,8,"E")) I ARSTAT="COLLECTED/CLOSED" S ARSTAT="C/C"
  1.  . . ; quit if status cancelled (ib) or no charge
  1.  . . I IBSTAT=10 Q  ; cancelled
  1.  . . I '$P(IBZ,"^",7) Q  ; no charge
  1.  . . ; quit if AR STATUS is not on the list and IB status is not ON HOLD.  Question - what about CANCELLED BILL (#26)
  1.  . . S REAS=2 I IBARX,$P(IBARBILL,"^",2)=26 Q
  1.  . . ; non inpatient, only talk to parent
  1.  . . S REAS=3 I $P(IBZ,U,4)'?1"405:".E,$P(IBZ,U,4)'?1"45:".E,$$PARENTE^RCDMCR5B(IBX)'=IBX Q
  1.  . . ; inpatient, check if parent event or parent charge is cancelled.
  1.  . . I $P(IBZ,U,4)?1"405:".E!($P(IBZ,U,4)'?1"45:".E) S PAR=$$PARENTE^RCDMCR5B(IBX) I PAR S PARZ=^IB(PAR,0) I $P(PARZ,U,5)=10 Q
  1.  . . I $P(IBZ,U,4)?1"405:".E!($P(IBZ,U,4)'?1"45:".E) S PAR=$$PARENTC^RCDMCR5B(IBX) I PAR S PARZ=^IB(PAR,0) I $P(PARZ,U,5)=10 Q
  1.  . . ; quit if CD effective date not before event date
  1.  . . S REAS=4 Q:IBDT<3100505  Q:IBDT<CDDATE
  1.  . . ; quit if not within specified date range
  1.  . . S REAS=5 Q:IBDT<IBBDT!(IBDT>IBEDT)  Q:EOCDT<IBBDT!(EOCDT>IBEDT)
  1.  . . ; quit if LTC action type
  1.  . . S REAS=6 I $P($G(^IBE(350.1,+$P(IBZ,"^",3),0)),"^")["LTC " Q
  1.  . . S REAS=7 Q:'IBDATA
  1.  . . ; quit if not the right fund
  1.  . . S REAS=8 I IBARX S FUND=$G(IBARDATA(430,IBARX,203,"E")) I FUND'=528703,FUND'=528701 Q
  1.  . . ; quit if AR STATUS is not on the list and IB status is not ON HOLD.  Question - what about CANCELLED BILL (#26)
  1.  . . S REAS=9 I '$F(",16,39,42,40,22,23,",","_$P(IBARBILL,U,2)_","),$P(IBZ,U,5)'=8 Q
  1.  . . S REAS=10 Q:EOCDT<3100505  Q:EOCDT<CDDATE
  1.  . . S IBDPT=$G(^DPT(DFN,0))
  1.  . . I PRCAADMT S MCDT=PRCAADMT   ;PRCA*4.5*386
  1.  . . I 'IBEXCEL D
  1.  . . . S REAS=0 W !,$E($P(IBDPT,"^"),1,20) ; patient name
  1.  . . . W ?21,$P(IBDPT,"^",9) ; snn
  1.  . . . W ?31,PRGRP ; Priority group
  1.  . . . W ?33,$$FMTE^XLFDT($G(IBDG("REVDTE")),"2DZ") ; Catastrophically Disabled Date, IA# 10103
  1.  . . . W ?42,$E($P($P(IBZ,"^",11),"-",2),1,8) ; ar bill no
  1.  . . . W:MCDT'="" ?50,$$FMTE^XLFDT(MCDT,"2DZ") ; Med Care Date
  1.  . . . W:RXDT'="" ?59,$$FMTE^XLFDT(RXDT,"2DZ") ; RX Date
  1.  . . . W ?68,$E($P(IBDATA,U,6),1,8) ; rx #
  1.  . . . W ?77,$E($P(IBDATA,U,7),1,20) ; rx name
  1.  . . . W ?98,$J("$"_$FN($P(IBDATA,U,8),"",2),9) ; charge
  1.  . . . W ?108,$E($P($G(^IBE(350.21,IBSTAT,0)),U),1,10) ; IBSTATUS
  1.  . . . W ?119,$E(ARSTAT,1,13) ; AR Status
  1.  . . . I $Y+3>IOSL D HEAD
  1.  . . I IBEXCEL D
  1.  . . . S REAS=0 W !,"""",$P(IBDPT,"^"),"""" ; patient name
  1.  . . . W U,$P(IBDPT,"^",9) ; snn
  1.  . . . W U,PRGRP ; Priority group
  1.  . . . W U,$$FMTE^XLFDT($G(IBDG("REVDTE")),"2DZ") ; Catastrophically Disabled Date, IA# 10103
  1.  . . . W U,$P($P(IBZ,"^",11),"-",2) ; ar bill no
  1.  . . . W U W:MCDT'="" $$FMTE^XLFDT(MCDT,"2DZ") ; Med Care Date
  1.  . . . W U W:RXDT'="" $$FMTE^XLFDT(RXDT,"2DZ") ; RX Date
  1.  . . . W U,$P(IBDATA,U,6) ; rx # (or get it from IBDATA?)
  1.  . . . W U,$P(IBDATA,U,7) ; rx name
  1.  . . . W U,"$",$FN($P(IBDATA,U,8),"",2) ; charge
  1.  . . . W U,$P($G(^IBE(350.21,IBSTAT,0)),U) ; IBSTATUS
  1.  . . . W U,ARSTAT ; AR Status
  1.  I 'IBQUIT,'IBEXCEL,IBP,$E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR I $D(DIRUT) S IBQUIT=1 Q
  1.  D ^%ZISC
  1. EXIT S:$D(ZTQUEUED) ZTREQ="@"
  1.  Q
  1.  N IBL,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1.  I 'IBEXCEL,IBP,$E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR I $D(DIRUT) S IBQUIT=1 Q
  1.  S IBP=IBP+1
  1.  I 'IBEXCEL D
  1.  . W @IOF,!,"Cross-Servicing Catastrophically Disabled Exempt Copayment Charge Report   --- Run Date: ",$$FMTE^XLFDT($$NOW^XLFDT,"9MP")," ---",?122,"Page: ",IBP
  1.  . W !,"Episode of Care Dates from ",$$FMTE^XLFDT(IBBDT,"9MP")," to ",$$FMTE^XLFDT(IBEDT,"9MP")
  1.  . W !,"                              Pri  CD             Medical   RX Fill                                  Charge"
  1.  . W !,"Patient Name           SSN    Grp  Date   Bill NO Care Date Date    RX #     RX Name                 Amount IB Status  AR Status",!
  1.  I IBEXCEL D
  1.  . W !,"Patient Name",U,"SSN",U,"Pri Grp",U,"CD Date",U,"Bill NO",U,"Medical Care Date",U,"RX Fill Date",U,"RX #",U
  1.  . W "RX Name",U,"Charge Amount",U,"IB Status",U,"AR Status",U
  1.  I 'IBEXCEL F IBL=1:1:$S(IOM:IOM,1:132) W "-"
  1.  Q
  1. EXCEL() ; Export the report to MS Excel?
  1.  ; Function return values:
  1.  ;   0 - User selected "No" at prompt.
  1.  ;   1 - User selected "Yes" at prompt.
  1.  ;   ^ - User aborted.
  1.  ; This function allows the user to indicate whether the report should be
  1.  ; printed in a format that could easily be imported into an Excel
  1.  ; spreadsheet.  If the user wants to print in EXCEL format, the variable 
  1.  ; IBEXCEL will be set to '1', otherwise IBEXCEL will be set to '0' for "No" 
  1.  ; or "^" to abort.
  1.  ;
  1.  N DIR,DIRUT,Y
  1.  S DIR(0)="Y"
  1.  S DIR("A")="Do you want to capture report data for an Excel document"
  1.  I $G(IBEXCEL)=1 S DIR("B")="YES"
  1.  E  S DIR("B")="NO"
  1.  S DIR("?",1)="If you want to capture the output from this report in a format that"
  1.  S DIR("?",2)="could easily be imported into an Excel spreadsheet, then answer YES here."
  1.  S DIR("?")="If you want a normal report output, then answer NO here."
  1.  W !
  1.  D ^DIR
  1.  K DIR
  1.  I $D(DIRUT) Q "^" ; Abort
  1.  Q +Y
  1. DATE ;
  1.  ;  -get beginning and ending dates
  1.  ;  -output in ibbdt - beginning date
  1.  ;             ibedt - ending date
  1.  ;
  1. BDT ;  -get beginning date
  1.  S (IBBDT,IBEDT)=""
  1.  ;S %DT(0)=3100505
  1.  S %DT("B")="May 5, 2010"
  1.  S %DT="AEX",%DT("A")="Start with DATE: " D ^%DT K %DT G DATEQ:Y<0
  1.  S IBBDT=Y
  1.  I IBBDT<3100505 S IBBDT=3100505 ;W !,"Start date changed to 5/5/2010"
  1.  ;
  1. EDT ;  -get ending date
  1.  S %DT="AEX",%DT("A")="Go to DATE: ",%DT("B")="T" D ^%DT S:X=" " X=IBBDT
  1.  G DATEQ:(X="")!(X["^") G EDT:Y<0
  1.  S IBEDT=Y I Y<IBBDT W *7," ??",!,"ENDING DATE must follow BEGINNING DATE." G BDT
  1.  ;
  1. DATEQ K %DT
  1.  Q
  1. EXMSG ;
  1.  W !,"This report may take a while to process.  To capture as an Excel"
  1.  W !,"format, it is recommended that you queue this report to a spool device"
  1.  W !,"with margins of 256 and page length of 99999 (e.g. spoolname;256;99999)."
  1.  W !,"This should help avoid wrapping problems."
  1.  W !!,"Another method would be to set up your terminal to capture the detail"
  1.  W !,"report data.  On some terminals, this can be done by clicking on the "
  1.  W !,"'Tools' menu above, then click on 'Capture Incoming Data' to save to"
  1.  W !,"Desktop.  To avoid undesired wrapping of the data saved to the file,"
  1.  W !,"please enter '0;256;99999' at the 'DEVICE:' prompt."
  1.  Q