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

RCDPRTP.m

Go to the documentation of this file.
  1. RCDPRTP ;ALB/LDB-CLAIMS MATCHING REPORT ;1/11/01 2:03 PM
  1. ;;4.5;Accounts Receivable;**151,186,315,339,338**;Mar 20, 1995;Build 69
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. EN ;
  1. N DATEEND,DATESTRT,DIC,DIR,DIRUT,POP,RCBILL,RCDEBT,RCDFN,RCPT,RCSORT,RCQUIT,%ZIS,ZTDESC,ZTSAVE,ZTRTN,Y,RCAN,DIOEND,ZTIO,RCTYPE
  1. W !
  1. K DIRUT S DIR(0)="S^1:Patient;2:Bill Number;3:Payment dates;4:Receipt Number;5:Care Types",DIR("A")="Sort by" D ^DIR K DIR Q:$D(DIRUT)
  1. S RCSORT=Y,RCQUIT=""
  1. D @RCSORT Q:RCQUIT W !
  1. K DIRUT S DIR(0)="Y",DIR("A")="Include cancelled bills",DIR("B")="NO" D ^DIR S RCAN=+Y Q:$D(DIRUT)
  1. ;
  1. ; if user wants Excel output, then call the device question for Excel and then quit
  1. I $$FORMAT^RCDPRTP0(.RCEXCEL) D DEVICE^RCDPRTP0 Q ; exit point for Excel output
  1. Q:RCQUIT
  1. ;
  1. ; At this point, the user wants non-Excel output. Ask device question for non-Excel output.
  1. W !!,"This report requires 132 columns.",!!
  1. K IOP,IO("Q") S %ZIS="MQ",%ZIS("B")="" D ^%ZIS Q:POP
  1. I $D(IO("Q")) D Q
  1. .S ZTDESC="Claims Matching Report",ZTRTN="DQ^RCDPRTP"
  1. .S ZTSAVE("RCSORT")=""
  1. . I RCSORT=1 S ZTSAVE("RCDEBT")="",ZTSAVE("RCDFN")="",ZTSAVE("RCTYPE*")=""
  1. . I RCSORT=2 S ZTSAVE("RCBILL")="",ZTSAVE("RCDFN")="",ZTSAVE("RCDEBT")=""
  1. . I RCSORT=4 S ZTSAVE("RCPT")=""
  1. . I RCSORT=5 S ZTSAVE("RCTYPE*")=""
  1. . S ZTSAVE("RCAN")="",ZTSAVE("ZTREQ")="@",ZTSAVE("^TMP(""RCDPRTPB"",$J,")=""
  1. . S ZTSAVE("DATEEND")="",ZTSAVE("DATESTRT")="",ZTSAVE("RCQUIT")="",ZTSAVE("RCSORT")="",ZTSAVE("RCEXCEL")=""
  1. . S ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL
  1. . S DIOEND="K ^TMP(""RCDPRTPB"",$J)"
  1. .D ^%ZTLOAD,HOME^%ZIS K IO("Q") W !,"Task# ",ZTSK
  1. W !!,?20,"<*> please wait <*>"
  1. DQ ; queued report starts here
  1. U IO
  1. K ^TMP("RCDPRTPB",$J),^TMP("IBRBT",$J),^TMP("IBRBF",$J)
  1. N DAT,RCBIL,RCBIL0,RCNAM,RCPAY,RCPAY1,RCREC,RCREC1,RCRECTDA,RCSSN,RCTYP
  1. D @($S(RCSORT=1:"PAT",RCSORT=2:"BILL",RCSORT=3:"DATE",RCSORT=4:"REC",RCSORT=5:"TYPE")_"^RCDPRTP0")
  1. Q:RCQUIT
  1. D EN^RCDPRTP1
  1. W !!,?20,"<End of report>",!
  1. K DATESTRT,DATEEND,^TMP("RCDPRTPB",$J),RCTYPE
  1. D ^%ZISC
  1. Q
  1. ;
  1. 1 ;
  1. S DIC(0)="QEAMZ",DIC=340,DIC("S")="I ^RCD(340,+Y,0)[""DPT""",DIC("A")="Patient name: " D ^DIC I Y<0 S RCQUIT=1 Q
  1. S RCDEBT=+Y,RCDFN=+$P(Y,"^",2)
  1. D TYPEPIC^RCDPRTP0(.RCTYPE) I '$D(RCTYPE) S RCQUIT=1 Q
  1. D DATESEL^RCRJRTRA("Payment")
  1. I '$G(DATESTRT)!('$G(DATEEND)) S RCQUIT=1
  1. Q
  1. ;
  1. 3 ;
  1. D DATESEL^RCRJRTRA("Payment")
  1. I '$G(DATESTRT)!('$G(DATEEND)) S RCQUIT=1
  1. Q
  1. ;
  1. 2 ;
  1. N DIC,DUOUT
  1. K ^TMP("IBRBF",$J)
  1. S DIC(0)="QEAM",DIC=430,DIC("S")="I $$SCRNARCT^RCDPRTP($P(^(0),U,2))" D ^DIC I Y<0 S RCQUIT=1 Q
  1. S RCBILL=+Y,RCDFN=$P($G(^PRCA(430,+RCBILL,0)),"^",7) Q:'RCDFN
  1. S RCDEBT=$O(^RCD(340,"B",RCDFN_";DPT(",0))
  1. I (RCDFN="")!(RCDEBT="") W !,"This bill has no matching first party bills." G 2
  1. D RELBILL^IBRFN(RCBILL)
  1. I '$O(^TMP("IBRBF",$J,RCBILL,0)) W !,"This bill has no matching first party debts." K ^TMP("IBRBF",$J) G 2
  1. K ^TMP("IBRBF",$J)
  1. Q
  1. ;
  1. 4 ;
  1. N DIC,X,Y
  1. S DIC(0)="QEAM",DIC=344 D ^DIC I Y<0 S RCQUIT=1 Q
  1. S RCPT=$P(Y,"^",2)
  1. Q
  1. ;
  1. 5 ; Select care type - added in patch 315
  1. D TYPEPIC^RCDPRTP0(.RCTYPE) I '$D(RCTYPE) S RCQUIT=1 Q
  1. Q:RCQUIT
  1. D DATESEL^RCRJRTRA("Payment")
  1. I '$G(DATESTRT)!('$G(DATEEND)) S RCQUIT=1
  1. Q
  1. ;
  1. EXIT ;
  1. K DATESTRT,DATEEND,RCEXCEL,^TMP("RCDPRTPB",$J),^TMP("IBRBT",$J)
  1. K ^TMP("IBRBT1",$J),^TMP("IBRBF",$J),^TMP("IBRBF1",$J),RCTYPE
  1. Q
  1. ;
  1. ;PRCA*4.5*338 - update AR Cat screen to include FEE and CC Reimb Ins Types
  1. SCRNARCT(RCARCT) ;
  1. ;
  1. Q:RCARCT=9 1 ;Allow Reimb Insurance
  1. Q:RCARCT=45 1 ;Allow FEE Reimb Insurance
  1. I RCARCT>47,(RCARCT<52) Q 1 ;Allow CC Reimb Insurances
  1. Q 0 ;Disallow everything else