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