RCDPRTP1 ;ALB/LDB - CLAIMS MATCHING REPORT (PRINT) ;1/26/01 2:56 PM
;;4.5;Accounts Receivable;**151,169,276,284,315,339,351**;Mar 20, 1995;Build 15
;;Per VA Directive 6402, this routine should not be modified.
;
EN ; Entry point to print the Claims Matching Report.
N %,DATEDIS1,DATEDIS2,NOW,PG,RCBILL,RCAMT,RCAMT1,RCIBDAT,RCIBFN,RCNAM,RCNAM1,RCNO,RCNOW,RCDLINE,RCLINE,RCPHIT
; PRCA*4.5*284 - Remove RCPT 'new' as this is the receipt # from user entry
N RCQ,RCSSN,RCSTAT,RCTP,X,Y,RCLPFLG
;
; - initialize report header variables
S PG=0
Q:RCQUIT
I RCSORT'=2,(RCSORT'=4) D
.S Y=$P(DATESTRT,".") D DD^%DT S DATEDIS1=Y
.S Y=$P(DATEEND,".") D DD^%DT S DATEDIS2=Y
D NOW^%DTC S Y=% D DD^%DT S RCNOW=$E(Y,1,18)
S RCDLINE=$TR($J("",80)," ","-")
S RCLINE=$TR($J("",80)," ","*")
;
; - main report loop
K ^TMP($J)
;
I 'RCEXCEL D HDR ; initial header
S RCNO=0 ; flag to indicate at least one matching claim
;
S RCNAM="" F S RCNAM=$O(^TMP("RCDPRTPB",$J,RCNAM)) Q:RCNAM=""!$G(RCQ) D
.S RCBILL=0 F S RCBILL=$O(^TMP("RCDPRTPB",$J,RCNAM,RCBILL)) Q:'RCBILL!$G(RCQ) D
..S RCPHIT=0 ; flag that requires patient info to print
..D PROC ; process a single third party bill
..K ^TMP("IBRBT",$J),^TMP("IBRBF",$J)
;
I $G(RCQ) G ENQ
;
I $O(^TMP("RCDPRTPB",$J,0))="" W !!,?18,"No matching debts." Q
;I 'RCNO W !!,?18,"No matching debts."
ENQ ;
Q
;
;
PROC ; Process each third party bill for a patient.
D RELBILL^IBRFN(RCBILL)
S RCQUIT=0 ;added for care type check
;Add code to check ^TMP("IBRBT",$J -------------------------------------------------------------------------------for third party charges
I $D(RCTYPE)>1,$D(^TMP("IBRBT",$J)) N J S J=0 F S J=$O(^TMP("IBRBT",$J,RCBILL,J)) Q:'J D
. S RCTYP=$$TYP^IBRFN(J),RCTYP=$S(RCTYP="":-1,RCTYP="PR":"P",RCTYP="PH":"R",1:RCTYP)
. I '$D(RCTYPE(RCTYP)) K ^TMP("IBRBT",$J,RCBILL,J) ; Verify that the type is one of the selected type, if not delete the ^TMP global node for that claim
; - quit if there are no associated first party bills
I '$O(^TMP("IBRBF",$J,0)) K ^TMP("RCDPRTPB",$J,RCNAM,RCBILL) G PROCQ
;
S (RCAMT(0),RCAMT(1))=0
S RCTP(0)=0 F S RCTP(0)=$O(^TMP("IBRBF",$J,RCTP(0))) Q:'RCTP(0) S RCTP(1)=0 F S RCTP(1)=$O(^TMP("IBRBF",$J,RCTP(0),RCTP(1))) Q:'RCTP(1) S ^TMP($J,"IBRBF",RCTP(1),RCTP(0))=""
; PRCA*4.5*284 - Change typo of RCPT(0)=0 to RCTP(0)=0
S RCTP(0)=0 F S RCTP(0)=$O(^TMP($J,"IBRBF",RCTP(0))) Q:'RCTP(0) S RCTP(1)=0 F S RCTP(1)=$O(^TMP($J,"IBRBF",RCTP(0),RCTP(1))) Q:'RCTP(1) D
.I RCTP(1)=RCBILL Q
.I $D(^TMP($J,"IBRBF",RCTP(0),RCBILL))!(RCTP(1)'=$O(^TMP($J,"IBRBF",RCTP(0),0))) K ^TMP("IBRBF",$J,RCTP(1),RCTP(0)),^TMP($J,"IBRBF",RCTP(0),RCTP(1)) I '$O(^TMP("IBRBF",$J,RCTP(1),0)) K ^TMP("IBRBF",$J,RCTP(1))
;
S RCTP(0)="" F S RCTP(0)=$O(^TMP("IBRBT",$J,RCBILL,RCTP(0))) Q:RCTP(0)="" D
.;if associated third party has had payment also do not list twice
.I $D(^TMP("RCDPRTPB",$J,RCNAM,RCTP(0))),(RCBILL'=RCTP(0)) S RCTP(RCTP(0))=^TMP("RCDPRTPB",$J,RCNAM,RCTP(0)) K ^(RCTP(0))
.;if no prescription coverage exclude associated rx co-pay charges
.I '$P(^TMP("IBRBT",$J,RCBILL),"^") D
..S RCTP(1)=0 F S RCTP(1)=$O(^TMP("IBRBF",$J,RCTP(0),RCTP(1))) Q:RCTP(1)="" I $G(^TMP("IBRBF",$J,RCTP(0),RCTP(1)))["RX" K ^TMP("IBRBF",$J,RCTP(0),RCTP(1)) I '$O(^TMP("IBRBF",$J,RCTP(0),"")) K ^TMP("IBRBF",$J,RCTP(0))
.;if duplicate charges exclude them from report
S RCTP(0)=0 F S RCTP(0)=$O(^TMP("IBRBF",$J,RCTP(0))) Q:RCTP(0)="" S RCTP(1)=0 F S RCTP(1)=$O(^TMP("IBRBF",$J,RCTP(0),RCTP(1))) Q:'RCTP(1) D
.I RCTP(0)'=RCBILL,($D(^TMP("IBRBF",$J,RCBILL,RCTP(1)))) K ^TMP("IBRBF",$J,RCTP(0),RCTP(1)) K:'$O(^TMP("IBRBF",$J,RCTP(0),0)) ^TMP("IBRBF",$J,RCTP(0))
;
;exclude cancelled charges if not selected to be on report
I 'RCAN D
.S RCTP(0)=0 F S RCTP(0)=$O(^TMP("IBRBF",$J,RCTP(0))) Q:RCTP(0)="" S RCTP(1)=0 F S RCTP(1)=$O(^TMP("IBRBF",$J,RCTP(0),RCTP(1))) Q:'RCTP(1) D
..I $P(^TMP("IBRBF",$J,RCTP(0),RCTP(1)),"^",3) K ^TMP("IBRBF",$J,RCTP(0),RCTP(1)) Q
..S RCPT(2)=$O(^PRCA(430,"B",+$P(^TMP("IBRBF",$J,RCTP(0),RCTP(1)),"^",4),0)) I ($P($G(^PRCA(430,+RCPT(2),0)),"^",8)=39)!($P($G(^PRCA(430,+RCPT(2),0)),"^",8)=26) K ^TMP("IBRBF",$J,RCTP(0),RCTP(1))
..I '$O(^TMP("IBRBF",$J,RCTP(0),"")) K ^TMP("IBRBF",$J,RCTP(0))
I '$O(^TMP("IBRBF",$J,RCBILL,0)) K ^TMP("RCDPRTPB",$J,RCNAM,RCBILL) G PROCQ
;
I RCEXCEL D PRNTPAT^RCDPRTEX K ^TMP($J) Q ;Print in claims in excel format and quit
;
; - print patient detail line
I 'RCPHIT S RCPHIT=1 D PRINT3^RCDPRTP2 G:$G(RCQ) PROCQ
;
; - print third party bills
; o print the header first; need room for the header and
; the bill that was paid.
; o print the bill that was paid.
S RCTP=RCBILL,RCIBDAT=$G(^TMP("IBRBT",$J,RCBILL,RCBILL))
I $Y>(IOSL-7) D PAUSE^RCDPRTP2 G:$G(RCQ) PROCQ D HDR
D HDR1^RCDPRTP2,PRINT1^RCDPRTP2 G:$G(RCQ) PROCQ
;
; PRCA*4.5*284, corrected typo of 'assoicated' to 'associated'
; - print the other associated third party bills
S RCTP=0 F S RCTP=$O(^TMP("IBRBT",$J,RCBILL,RCTP)) Q:'RCTP!$G(RCQ) D
.I RCBILL=RCTP Q ; don't reprint the bill that was paid.
.S RCIBDAT=$G(^TMP("IBRBT",$J,RCBILL,RCTP))
.I 'RCAN,($P(RCIBDAT,"^",3)) Q ; exclude cancelled claims
.D PRINT1^RCDPRTP2
G:$G(RCQ) PROCQ
;
; - print the third party totals
; PRCA*4.5*276 - adjusted header to make room for EEOB indicator '%'
I $Y>(IOSL-2) D PAUSE^RCDPRTP2 G:$G(RCQ) PROCQ D HDR W !
W !,?63,"----------",?75,"----------"
W !,?64,$J(RCAMT(0),9,2),?76,$J(RCAMT(1),9,2)
;
; - print the associated first party charges
;
; PRCA*4.5*315 new screen for first party charges by (CARE TYPES)
; check global node ^TMP("IBRBF",$J, all bills, all charges) --
N RCACTYP,I,J ;Do the next section of code only if Care Types were selected - Stored in RCTYPE([care type])
; We must loop through all Bills and First party charges for this screening
I $D(RCTYPE)>1 S I=0 F S I=$O(^TMP("IBRBF",$J,I)) Q:'I S J=0 F S J=$O(^TMP("IBRBF",$J,I,J)) Q:'J D
. S RCACTYP=$P(^TMP("IBRBF",$J,I,J),U,6) Q:RCACTYP="" ;6th piece is Action Type
. I RCACTYP["TRICARE"!(RCACTYP["CHAMPVA") Q ;Not needed for screening 1st party charges
. ;PRCA*4.5*351 - Allow Community Care RX to appear on the Outpatient Care Type Reports
. I RCACTYP["RX" D Q
.. Q:RCACTYP["CC"
.. Q:RCACTYP["CHOICE"
.. S RCTYP="R" D KILFPTY
. ;end PRCA*4.5*351
. I RCACTYP["OPT"!(RCACTYP["OBSERV") S RCTYP="O" D KILFPTY Q
. I RCACTYP["INPT"!(RCACTYP["NHCU")!(RCACTYP["ADMIS")!(RCACTYP["MEDICARE DEDUCTIBLE")!(RCACTYP["PER DIEM") S RCTYP="I" D KILFPTY Q
. Q
;
S RCTP(0)=0,RCLPFLG=0 F S RCTP(0)=$O(^TMP("IBRBF",$J,RCTP(0))) Q:'RCTP(0)!$G(RCQ) D
.Q:$D(^TMP("IBRBF",$J,RCTP(0)))<10 ;New code - quit if ^TMP("IBRBF" has no sub nodes
.I $Y>(IOSL-5) D PAUSE^RCDPRTP2 Q:$G(RCQ) D HDR
.; - print the header for the first charge
.I 'RCLPFLG D HDR2^RCDPRTP2 S RCLPFLG=1
.S RCTP=0 F S RCTP=$O(^TMP("IBRBF",$J,RCTP(0),RCTP)) Q:'RCTP!$G(RCQ) D
..S RCNO=1 ; set flag for at least one match
..S RCIBDAT=$G(^TMP("IBRBF",$J,RCTP(0),RCTP))
..; - print the patient detail line
..I RCNO D PRINT2^RCDPRTP2
;.
; PRCA*4.5*284, cleanup ^TMP($J) only
PROCQ ;
K ^TMP($J) Q
;
;
HDR ; Print the main report header.
S PG=PG+1 I PG'=1!($E(IOST,1,2)="C-") W @IOF
W !,?5,"THIRD PARTY CLAIMS W/MATCHING FIRST PARTY DEBTS ",RCNOW," PAGE ",PG
I RCSORT'=2,(RCSORT'=4) W !,?18,"FOR THE PAYMENT DATES: ",DATEDIS1," TO ",DATEDIS2
I RCSORT=4 W !,?18,"RECEIPT NUMBER ",RCPT
W !,RCDLINE
I PG=1 D
.W !!,"Remember that any actions taken to decrease the first party receivables must"
.W !,"consider any applicable deductibles or coinsurance amounts specified on the EOB."
Q
;
;PRCA*4.5*315
KILFPTY ;KILL 1st party associated claim from ^TMP("IBRBF", $J), used to screen out unwanted 1st party bills (wrong Care Type)
;Verify that the type is one of the selected care types, if not delete the ^TMP global node for that charge
I '$D(RCTYPE(RCTYP)) K ^TMP("IBRBF",$J,I,J)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPRTP1 8102 printed Sep 23, 2025@19:22:33 Page 2
RCDPRTP1 ;ALB/LDB - CLAIMS MATCHING REPORT (PRINT) ;1/26/01 2:56 PM
+1 ;;4.5;Accounts Receivable;**151,169,276,284,315,339,351**;Mar 20, 1995;Build 15
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
EN ; Entry point to print the Claims Matching Report.
+1 NEW %,DATEDIS1,DATEDIS2,NOW,PG,RCBILL,RCAMT,RCAMT1,RCIBDAT,RCIBFN,RCNAM,RCNAM1,RCNO,RCNOW,RCDLINE,RCLINE,RCPHIT
+2 ; PRCA*4.5*284 - Remove RCPT 'new' as this is the receipt # from user entry
+3 NEW RCQ,RCSSN,RCSTAT,RCTP,X,Y,RCLPFLG
+4 ;
+5 ; - initialize report header variables
+6 SET PG=0
+7 if RCQUIT
QUIT
+8 IF RCSORT'=2
IF (RCSORT'=4)
Begin DoDot:1
+9 SET Y=$PIECE(DATESTRT,".")
DO DD^%DT
SET DATEDIS1=Y
+10 SET Y=$PIECE(DATEEND,".")
DO DD^%DT
SET DATEDIS2=Y
End DoDot:1
+11 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET RCNOW=$EXTRACT(Y,1,18)
+12 SET RCDLINE=$TRANSLATE($JUSTIFY("",80)," ","-")
+13 SET RCLINE=$TRANSLATE($JUSTIFY("",80)," ","*")
+14 ;
+15 ; - main report loop
+16 KILL ^TMP($JOB)
+17 ;
+18 ; initial header
IF 'RCEXCEL
DO HDR
+19 ; flag to indicate at least one matching claim
SET RCNO=0
+20 ;
+21 SET RCNAM=""
FOR
SET RCNAM=$ORDER(^TMP("RCDPRTPB",$JOB,RCNAM))
if RCNAM=""!$GET(RCQ)
QUIT
Begin DoDot:1
+22 SET RCBILL=0
FOR
SET RCBILL=$ORDER(^TMP("RCDPRTPB",$JOB,RCNAM,RCBILL))
if 'RCBILL!$GET(RCQ)
QUIT
Begin DoDot:2
+23 ; flag that requires patient info to print
SET RCPHIT=0
+24 ; process a single third party bill
DO PROC
+25 KILL ^TMP("IBRBT",$JOB),^TMP("IBRBF",$JOB)
End DoDot:2
End DoDot:1
+26 ;
+27 IF $GET(RCQ)
GOTO ENQ
+28 ;
+29 IF $ORDER(^TMP("RCDPRTPB",$JOB,0))=""
WRITE !!,?18,"No matching debts."
QUIT
+30 ;I 'RCNO W !!,?18,"No matching debts."
ENQ ;
+1 QUIT
+2 ;
+3 ;
PROC ; Process each third party bill for a patient.
+1 DO RELBILL^IBRFN(RCBILL)
+2 ;added for care type check
SET RCQUIT=0
+3 ;Add code to check ^TMP("IBRBT",$J -------------------------------------------------------------------------------for third party charges
+4 IF $DATA(RCTYPE)>1
IF $DATA(^TMP("IBRBT",$JOB))
NEW J
SET J=0
FOR
SET J=$ORDER(^TMP("IBRBT",$JOB,RCBILL,J))
if 'J
QUIT
Begin DoDot:1
+5 SET RCTYP=$$TYP^IBRFN(J)
SET RCTYP=$SELECT(RCTYP="":-1,RCTYP="PR":"P",RCTYP="PH":"R",1:RCTYP)
+6 ; Verify that the type is one of the selected type, if not delete the ^TMP global node for that claim
IF '$DATA(RCTYPE(RCTYP))
KILL ^TMP("IBRBT",$JOB,RCBILL,J)
End DoDot:1
+7 ; - quit if there are no associated first party bills
+8 IF '$ORDER(^TMP("IBRBF",$JOB,0))
KILL ^TMP("RCDPRTPB",$JOB,RCNAM,RCBILL)
GOTO PROCQ
+9 ;
+10 SET (RCAMT(0),RCAMT(1))=0
+11 SET RCTP(0)=0
FOR
SET RCTP(0)=$ORDER(^TMP("IBRBF",$JOB,RCTP(0)))
if 'RCTP(0)
QUIT
SET RCTP(1)=0
FOR
SET RCTP(1)=$ORDER(^TMP("IBRBF",$JOB,RCTP(0),RCTP(1)))
if 'RCTP(1)
QUIT
SET ^TMP($JOB,"IBRBF",RCTP(1),RCTP(0))=""
+12 ; PRCA*4.5*284 - Change typo of RCPT(0)=0 to RCTP(0)=0
+13 SET RCTP(0)=0
FOR
SET RCTP(0)=$ORDER(^TMP($JOB,"IBRBF",RCTP(0)))
if 'RCTP(0)
QUIT
SET RCTP(1)=0
FOR
SET RCTP(1)=$ORDER(^TMP($JOB,"IBRBF",RCTP(0),RCTP(1)))
if 'RCTP(1)
QUIT
Begin DoDot:1
+14 IF RCTP(1)=RCBILL
QUIT
+15 IF $DATA(^TMP($JOB,"IBRBF",RCTP(0),RCBILL))!(RCTP(1)'=$ORDER(^TMP($JOB,"IBRBF",RCTP(0),0)))
KILL ^TMP("IBRBF",$JOB,RCTP(1),RCTP(0)),^TMP($JOB,"IBRBF",RCTP(0),RCTP(1))
IF '$ORDER(^TMP("IBRBF",$JOB,RCTP(1),0))
KILL ^TMP("IBRBF",$JOB,RCTP(1))
End DoDot:1
+16 ;
+17 SET RCTP(0)=""
FOR
SET RCTP(0)=$ORDER(^TMP("IBRBT",$JOB,RCBILL,RCTP(0)))
if RCTP(0)=""
QUIT
Begin DoDot:1
+18 ;if associated third party has had payment also do not list twice
+19 IF $DATA(^TMP("RCDPRTPB",$JOB,RCNAM,RCTP(0)))
IF (RCBILL'=RCTP(0))
SET RCTP(RCTP(0))=^TMP("RCDPRTPB",$JOB,RCNAM,RCTP(0))
KILL ^(RCTP(0))
+20 ;if no prescription coverage exclude associated rx co-pay charges
+21 IF '$PIECE(^TMP("IBRBT",$JOB,RCBILL),"^")
Begin DoDot:2
+22 SET RCTP(1)=0
FOR
SET RCTP(1)=$ORDER(^TMP("IBRBF",$JOB,RCTP(0),RCTP(1)))
if RCTP(1)=""
QUIT
IF $GET(^TMP("IBRBF",$JOB,RCTP(0),RCTP(1)))["RX"
KILL ^TMP("IBRBF",$JOB,RCTP(0),RCTP(1))
IF '$ORDER(^TMP("IBRBF",$JOB,RCTP(0),""))
KILL ^TMP("IBRBF",$JOB,RCTP(0))
End DoDot:2
+23 ;if duplicate charges exclude them from report
End DoDot:1
+24 SET RCTP(0)=0
FOR
SET RCTP(0)=$ORDER(^TMP("IBRBF",$JOB,RCTP(0)))
if RCTP(0)=""
QUIT
SET RCTP(1)=0
FOR
SET RCTP(1)=$ORDER(^TMP("IBRBF",$JOB,RCTP(0),RCTP(1)))
if 'RCTP(1)
QUIT
Begin DoDot:1
+25 IF RCTP(0)'=RCBILL
IF ($DATA(^TMP("IBRBF",$JOB,RCBILL,RCTP(1))))
KILL ^TMP("IBRBF",$JOB,RCTP(0),RCTP(1))
if '$ORDER(^TMP("IBRBF",$JOB,RCTP(0),0))
KILL ^TMP("IBRBF",$JOB,RCTP(0))
End DoDot:1
+26 ;
+27 ;exclude cancelled charges if not selected to be on report
+28 IF 'RCAN
Begin DoDot:1
+29 SET RCTP(0)=0
FOR
SET RCTP(0)=$ORDER(^TMP("IBRBF",$JOB,RCTP(0)))
if RCTP(0)=""
QUIT
SET RCTP(1)=0
FOR
SET RCTP(1)=$ORDER(^TMP("IBRBF",$JOB,RCTP(0),RCTP(1)))
if 'RCTP(1)
QUIT
Begin DoDot:2
+30 IF $PIECE(^TMP("IBRBF",$JOB,RCTP(0),RCTP(1)),"^",3)
KILL ^TMP("IBRBF",$JOB,RCTP(0),RCTP(1))
QUIT
+31 SET RCPT(2)=$ORDER(^PRCA(430,"B",+$PIECE(^TMP("IBRBF",$JOB,RCTP(0),RCTP(1)),"^",4),0))
IF ($PIECE($GET(^PRCA(430,+RCPT(2),0)),"^",8)=39)!($PIECE($GET(^PRCA(430,+RCPT(2),0)),"^",8)=26)
KILL ^TMP("IBRBF",$JOB,RCTP(0),RCTP(1))
+32 IF '$ORDER(^TMP("IBRBF",$JOB,RCTP(0),""))
KILL ^TMP("IBRBF",$JOB,RCTP(0))
End DoDot:2
End DoDot:1
+33 IF '$ORDER(^TMP("IBRBF",$JOB,RCBILL,0))
KILL ^TMP("RCDPRTPB",$JOB,RCNAM,RCBILL)
GOTO PROCQ
+34 ;
+35 ;Print in claims in excel format and quit
IF RCEXCEL
DO PRNTPAT^RCDPRTEX
KILL ^TMP($JOB)
QUIT
+36 ;
+37 ; - print patient detail line
+38 IF 'RCPHIT
SET RCPHIT=1
DO PRINT3^RCDPRTP2
if $GET(RCQ)
GOTO PROCQ
+39 ;
+40 ; - print third party bills
+41 ; o print the header first; need room for the header and
+42 ; the bill that was paid.
+43 ; o print the bill that was paid.
+44 SET RCTP=RCBILL
SET RCIBDAT=$GET(^TMP("IBRBT",$JOB,RCBILL,RCBILL))
+45 IF $Y>(IOSL-7)
DO PAUSE^RCDPRTP2
if $GET(RCQ)
GOTO PROCQ
DO HDR
+46 DO HDR1^RCDPRTP2
DO PRINT1^RCDPRTP2
if $GET(RCQ)
GOTO PROCQ
+47 ;
+48 ; PRCA*4.5*284, corrected typo of 'assoicated' to 'associated'
+49 ; - print the other associated third party bills
+50 SET RCTP=0
FOR
SET RCTP=$ORDER(^TMP("IBRBT",$JOB,RCBILL,RCTP))
if 'RCTP!$GET(RCQ)
QUIT
Begin DoDot:1
+51 ; don't reprint the bill that was paid.
IF RCBILL=RCTP
QUIT
+52 SET RCIBDAT=$GET(^TMP("IBRBT",$JOB,RCBILL,RCTP))
+53 ; exclude cancelled claims
IF 'RCAN
IF ($PIECE(RCIBDAT,"^",3))
QUIT
+54 DO PRINT1^RCDPRTP2
End DoDot:1
+55 if $GET(RCQ)
GOTO PROCQ
+56 ;
+57 ; - print the third party totals
+58 ; PRCA*4.5*276 - adjusted header to make room for EEOB indicator '%'
+59 IF $Y>(IOSL-2)
DO PAUSE^RCDPRTP2
if $GET(RCQ)
GOTO PROCQ
DO HDR
WRITE !
+60 WRITE !,?63,"----------",?75,"----------"
+61 WRITE !,?64,$JUSTIFY(RCAMT(0),9,2),?76,$JUSTIFY(RCAMT(1),9,2)
+62 ;
+63 ; - print the associated first party charges
+64 ;
+65 ; PRCA*4.5*315 new screen for first party charges by (CARE TYPES)
+66 ; check global node ^TMP("IBRBF",$J, all bills, all charges) --
+67 ;Do the next section of code only if Care Types were selected - Stored in RCTYPE([care type])
NEW RCACTYP,I,J
+68 ; We must loop through all Bills and First party charges for this screening
+69 IF $DATA(RCTYPE)>1
SET I=0
FOR
SET I=$ORDER(^TMP("IBRBF",$JOB,I))
if 'I
QUIT
SET J=0
FOR
SET J=$ORDER(^TMP("IBRBF",$JOB,I,J))
if 'J
QUIT
Begin DoDot:1
+70 ;6th piece is Action Type
SET RCACTYP=$PIECE(^TMP("IBRBF",$JOB,I,J),U,6)
if RCACTYP=""
QUIT
+71 ;Not needed for screening 1st party charges
IF RCACTYP["TRICARE"!(RCACTYP["CHAMPVA")
QUIT
+72 ;PRCA*4.5*351 - Allow Community Care RX to appear on the Outpatient Care Type Reports
+73 IF RCACTYP["RX"
Begin DoDot:2
+74 if RCACTYP["CC"
QUIT
+75 if RCACTYP["CHOICE"
QUIT
+76 SET RCTYP="R"
DO KILFPTY
End DoDot:2
QUIT
+77 ;end PRCA*4.5*351
+78 IF RCACTYP["OPT"!(RCACTYP["OBSERV")
SET RCTYP="O"
DO KILFPTY
QUIT
+79 IF RCACTYP["INPT"!(RCACTYP["NHCU")!(RCACTYP["ADMIS")!(RCACTYP["MEDICARE DEDUCTIBLE")!(RCACTYP["PER DIEM")
SET RCTYP="I"
DO KILFPTY
QUIT
+80 QUIT
End DoDot:1
+81 ;
+82 SET RCTP(0)=0
SET RCLPFLG=0
FOR
SET RCTP(0)=$ORDER(^TMP("IBRBF",$JOB,RCTP(0)))
if 'RCTP(0)!$GET(RCQ)
QUIT
Begin DoDot:1
+83 ;New code - quit if ^TMP("IBRBF" has no sub nodes
if $DATA(^TMP("IBRBF",$JOB,RCTP(0)))<10
QUIT
+84 IF $Y>(IOSL-5)
DO PAUSE^RCDPRTP2
if $GET(RCQ)
QUIT
DO HDR
+85 ; - print the header for the first charge
+86 IF 'RCLPFLG
DO HDR2^RCDPRTP2
SET RCLPFLG=1
+87 SET RCTP=0
FOR
SET RCTP=$ORDER(^TMP("IBRBF",$JOB,RCTP(0),RCTP))
if 'RCTP!$GET(RCQ)
QUIT
Begin DoDot:2
+88 ; set flag for at least one match
SET RCNO=1
+89 SET RCIBDAT=$GET(^TMP("IBRBF",$JOB,RCTP(0),RCTP))
+90 ; - print the patient detail line
+91 IF RCNO
DO PRINT2^RCDPRTP2
End DoDot:2
End DoDot:1
+92 ;.
+93 ; PRCA*4.5*284, cleanup ^TMP($J) only
PROCQ ;
+1 KILL ^TMP($JOB)
QUIT
+2 ;
+3 ;
HDR ; Print the main report header.
+1 SET PG=PG+1
IF PG'=1!($EXTRACT(IOST,1,2)="C-")
WRITE @IOF
+2 WRITE !,?5,"THIRD PARTY CLAIMS W/MATCHING FIRST PARTY DEBTS ",RCNOW," PAGE ",PG
+3 IF RCSORT'=2
IF (RCSORT'=4)
WRITE !,?18,"FOR THE PAYMENT DATES: ",DATEDIS1," TO ",DATEDIS2
+4 IF RCSORT=4
WRITE !,?18,"RECEIPT NUMBER ",RCPT
+5 WRITE !,RCDLINE
+6 IF PG=1
Begin DoDot:1
+7 WRITE !!,"Remember that any actions taken to decrease the first party receivables must"
+8 WRITE !,"consider any applicable deductibles or coinsurance amounts specified on the EOB."
End DoDot:1
+9 QUIT
+10 ;
+11 ;PRCA*4.5*315
KILFPTY ;KILL 1st party associated claim from ^TMP("IBRBF", $J), used to screen out unwanted 1st party bills (wrong Care Type)
+1 ;Verify that the type is one of the selected care types, if not delete the ^TMP global node for that charge
+2 IF '$DATA(RCTYPE(RCTYP))
KILL ^TMP("IBRBF",$JOB,I,J)
+3 QUIT
+4 ;
