RCDPRTEX ;ALB/LMH - Claims Matching Report for Excel ;30-SEP 2016
;;4.5;Accounts Receivable;**315,339**;Mar 20, 1995;Build 2
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
PRINT ; Entry point for printing the Excel version of the report (either in foreground or background)
; Input:
; RCEXCEL=1 here
; Output:
; Report is printed in text format for Excel (turn on logging)
;
U IO
K ^TMP("RCDPRTPB",$J),^TMP("IBRBT",$J),^TMP("IBRBF",$J)
N DAT,RCBIL,RCBIL0,RCNAM,RCPAY,RCPAY1,RCREC,RCREC1,RCRECTDA,RCSSN,RCTYP,CRT,DIR,DIROUT,DIRUT,DTOUT,DUOUT
N RCSTOP,PAGE,SEPLINE,X,XX,Y,RCNO
S CRT=$S(IOST["C-":1,1:0) ; 1 - Print to Screen, 0 - Otherwise
I '$D(ZTQUEUED) U 0 W !!?5,"Compiling Claims Matching Report for Excel output. Please wait ... " U IO
;
; build the initial ^TMP("RCDPRTPB",$J) scratch global
D @($S(RCSORT=1:"PAT",RCSORT=2:"BILL",RCSORT=3:"DATE",RCSORT=4:"REC",RCSORT=5:"TYPE")_"^RCDPRTP0")
;
S IOSL=999999 ; Long screen length for Excel output
S PAGE=0,RCSTOP=0,$P(SEPLINE,"-",81)=""
;
I '$D(^TMP("RCDPRTPB",$J)) D Q
. W:CRT @IOF W:'CRT $C(13) ; initial form feed or page reset for no data found
. W !!?5,"No data found for this report."
. I CRT,'$D(ZTQUEUED) S DIR(0)="E" D ^DIR K DIR
. D ^%ZISC
. Q
;
START ;
N RCPAT0,NAME,BILLNUM,BILLFROM,BILLTO,RXCOV,RCIBFN,DOB,AMT,CHGTYP,STATUS
N RCH,AMT1,PAYOR,PST,FILLFROM,FILLTO,ONHOLD,RCAMT,RCAMT1,RCIBDAT,STRING,RCBILL0
N RCQ,RCSSN,RCTP,RCEXNAM,ELIG,FPCBILL,POSTDATE,RCDOB,RCFLAG,BAL,DATE,DEBTOR,RCDATE,RCDEBTOR,RCNAME
D EXCELHD
;
S RCNAM="" F S RCNAM=$O(^TMP("RCDPRTPB",$J,RCNAM)) Q:RCNAM="" D
.S RCBILL=0 F S RCBILL=$O(^TMP("RCDPRTPB",$J,RCNAM,RCBILL)) Q:'RCBILL D
..D DEMOG
..D PROC^RCDPRTP1 ; Process each third party bill for a patient.
..K ^TMP("IBRBT",$J),^TMP("IBRBF",$J)
;
D ^%ZISC
K ^TMP("RCDPRTPB",$J)
Q
;
DEMOG ; Demographic data for third party bills &
; first party charges detail line header
;
S RCPAT0=$G(^TMP("RCDPRTPB",$J,RCNAM))
S DATE=$G(^TMP("RCDPRTPB",$J,RCNAM,RCBILL))
S RCNAME=$P(RCNAM,"^")
S RCBILL0=$G(^PRCA(430,RCBILL,0))
S RCDFN=$P($G(^PRCA(430,RCBILL,0)),U,7)
S RCDOB=$P($G(^DPT(RCDFN,0)),U,3)
S DOB=$$FMTE^XLFDT(RCDOB,"5Z")
S DEBTOR=$P($G(RCBILL0),U,9)
S RCDEBTOR=$O(^RCD(340,"B",RCDFN_";DPT(",0)) Q:'RCDEBTOR
S RCSSN=$$SSN^RCFN01($G(RCDEBTOR))
S ELIG=$P($G(RCPAT0),U,2)
Q
;
PRNTPAT ; setup & print third party bills (called by PROC^RCDPRTP1 for Excel output only)
S RCTP=RCBILL,RCIBDAT=$G(^TMP("IBRBT",$J,RCBILL,RCBILL))
S STATUS=$$STAT^RCDPRTP2(RCTP) Q:STATUS="CN"!(STATUS="CB") ;Added a last minute check for cancelled third party bills
S RXCOV=$S('$G(^TMP("IBRBT",$J,RCBILL)):"NO",1:"YES")
S BILLNUM=$P(RCIBDAT,U,4) ; BILL #
S PST=$P(RCIBDAT,U,5) ; P/S/T
S BILLFROM=$$DATE^RCDPRTP2($P(RCIBDAT,U)) ; bill date from
S BILLTO=$$DATE^RCDPRTP2($P(RCIBDAT,U,2)) ; bill date to
S RCDATE=$S($G(RCTP(RCTP)):RCTP(RCTP),$G(^TMP("RCDPRTPB",$J,RCNAM,RCBILL)):^(RCBILL),1:"") I RCTP=RCBILL!($D(RCTP(RCTP))) S POSTDATE=$$DATE^RCDPRTP2(RCDATE)
S RCIBFN=RCTP
S RCDATE=$P($G(^PRCA(430,+RCTP,0)),U,14)
S POSTDATE=$S(RCDATE=DATE:$$DATE^RCDPRTP2(RCDATE),RCDATE'=DATE:"^")
S PAYOR=$P(RCIBDAT,U,7) ; payor
S RCAMT=$P($G(^PRCA(430,+RCTP,0)),"^",3) ; amt billed
S RCAMT1=$P($G(^PRCA(430,+RCTP,7)),"^",7) ; amt paid
S RCTYPE=$$TYP^IBRFN(RCTP) ;Third party bill type of care
S RCTYPE=$S(RCTYPE="":-1,RCTYPE="PR":"P",RCTYPE="PH":"R",1:RCTYPE)
S RCFLAG=RCTYPE
S RCTP=RCBILL
D EXCELPAT
;
EXCELTPB ; print other assoc. third party bills
S RCTP=0 F S RCTP=$O(^TMP("IBRBT",$J,RCBILL,RCTP)) Q:'RCTP D
.S STATUS=$$STAT^RCDPRTP2(RCTP) Q:STATUS="CN"!(STATUS="CB") ;Added a last minute check for cancelled third party bills
.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 bills
.D DEMOG
.S RXCOV=$S('$G(^TMP("IBRBT",$J,RCBILL)):"NO",1:"YES")
.S BILLNUM=$P(RCIBDAT,U,4) ; BILL #
.S PST=$P(RCIBDAT,U,5) ; P/S/T
.S BILLFROM=$$DATE^RCDPRTP2($P(RCIBDAT,U)) ; bill date from
.S BILLTO=$$DATE^RCDPRTP2($P(RCIBDAT,U,2)) ; bill date to
.S RCDATE=$P($G(^PRCA(430,+RCTP,0)),U,14)
.S POSTDATE=$S(RCDATE=DATE:$$DATE^RCDPRTP2(RCDATE),RCDATE'=DATE:"^")
.S RCIBFN=RCTP
.S PAYOR=$P(RCIBDAT,U,7) ; payor
.S RCAMT=$P($G(^PRCA(430,+RCTP,0)),"^",3) ; amt billed
.S RCAMT1=$P($G(^PRCA(430,+RCTP,7)),"^",7) ; amt paid
.S RCTYPE=$$TYP^IBRFN(RCTP) ;Third party bill type of care
.S RCTYPE=$S(RCTYPE="":-1,RCTYPE="PR":"P",RCTYPE="PH":"R",1:RCTYPE)
.D EXCELPAT
;
PRNTFPC ; print associated first party charges
; This code screens entries from file 350.1 returned by API - RELBILL^IBRFN
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["CHAMPA") Q ;Not needed for screening 1st party charges
. I RCACTYP["RX" S RCTYP="R" D KILFPTY^RCDPRTP1 Q
. I RCACTYP["OPT"!(RCACTYP["OBSERV") S RCTYP="O" D KILFPTY^RCDPRTP1 Q
. I RCACTYP["INPT"!(RCACTYP["NHCU")!(RCACTYP["ADMIS")!(RCACTYP["MEDICARE DECUCTIBLE") S RCTYP="I" D KILFPTY^RCDPRTP1 Q
. Q
;
S RCTP(0)=0 F S RCTP(0)=$O(^TMP("IBRBF",$J,RCTP(0))) Q:'RCTP(0)!$G(RCQ) D
.S RCTP=0 F S RCTP=$O(^TMP("IBRBF",$J,RCTP(0),RCTP)) Q:'RCTP!$G(RCQ) D
..S RCNO=1
..S RCIBDAT=$G(^TMP("IBRBF",$J,RCTP(0),RCTP))
..S RCIBFN=$P(RCIBDAT,U,4) I RCIBFN S RCIBFN=$O(^PRCA(430,"B",RCIBFN,0))
..D DEMOG
..S RXCOV=$S('$G(^TMP("IBRBT",$J,RCBILL)):"NO",1:"YES")
..S FILLFROM=$$DATE^RCDPRTP2(+RCIBDAT) ; Bill from
..S FILLTO=$$DATE^RCDPRTP2($P(RCIBDAT,U,2)) ; Bill to
..S CHGTYP=$P(RCIBDAT,U,6)
..S RCIBFN=$P(RCIBDAT,"^",4) I RCIBFN S RCIBFN=$O(^PRCA(430,"B",RCIBFN,0))
..S FPCBILL=$P(RCIBDAT,U,4)
..S STATUS=$$STAT^RCDPRTP2(RCIBFN) ; Status
..S ONHOLD=$P(RCIBDAT,U,7) ; # Days On Hold
..S AMT=$P(RCIBDAT,U,5) ; Amount billed
..S BAL=$S($G(^PRCA(430,+RCIBFN,7)):+($P(^(7),"^")+$P(^(7),"^",2)+$P(^(7),"^",3)+$P(^(7),"^",4)+$P(^(7),"^",4)),1:0)
..D EXCELFPC
.Q
Q
;
EXCELHD ; Print an Excel CSV header record
;
; Input: None
; Output: Header line printed for CSV format (excel)
;
W:CRT @IOF W:'CRT $C(13) ; initial form feed or page reset for Excel header line
N RCH
S STRING=""
S RCH=$$CSV("","Patient")
S RCH=$$CSV(RCH,"SSN")
S RCH=$$CSV(RCH,"DOB")
S RCH=$$CSV(RCH,"Prim. Elig")
S RCH=$$CSV(RCH,"RX Cvg")
S RCH=$$CSV(RCH,"Bill Type")
S RCH=$$CSV(RCH,"Bill#")
S RCH=$$CSV(RCH,"P/S/T")
S RCH=$$CSV(RCH,"Chg Type")
S RCH=$$CSV(RCH,"Status")
S RCH=$$CSV(RCH,"Bill From")
S RCH=$$CSV(RCH,"Bill To")
S RCH=$$CSV(RCH,"Posted")
S RCH=$$CSV(RCH,"Amt Billed")
S RCH=$$CSV(RCH,"Amt Pd")
S RCH=$$CSV(RCH,"Bal")
S RCH=$$CSV(RCH,"Care Type")
S RCH=$$CSV(RCH,"On Hold")
S RCH=$$CSV(RCH,"Payor")
W RCH
Q
;
EXCELPAT ; Print patient third party bills
;
; Input: None
; Output: Detail line printed for CSV format (excel)
;
N RCD
S STRING=""
S RCD=$$CSV("",RCNAME)_"^"_$E(RCNAME,1)_$E(RCSSN,6,9)
S RCD=$$CSV(RCD,DOB)
S RCD=$$CSV(RCD,ELIG)
S RCD=$$CSV(RCD,RXCOV)
S RCD=$$CSV(RCD,"Third Party Bill")
S RCD=$$CSV(RCD,BILLNUM)
S RCD=$$CSV(RCD,PST)
S RCD=$$CSV(RCD,"^")
S RCD=$$CSV(RCD,STATUS)
S RCD=$$CSV(RCD,BILLFROM)
S RCD=$$CSV(RCD,BILLTO)
S RCD=$$CSV(RCD,POSTDATE)
S RCD=$$CSV(RCD,RCAMT)
S RCD=$$CSV(RCD,RCAMT1)
S RCD=$$CSV(RCD,"^")
S RCD=$$CSV(RCD,RCTYPE)
S RCD=$$CSV(RCD,"^")
S RCD=$$CSV(RCD,PAYOR)
W !,RCD
K RCTP(RCTP)
Q
;
EXCELFPC ; Print patient first party charges
;
; Input: None
; Output: Detail line printed for CSV format (excel)
;
N RCB
S STRING=""
S RCB=$$CSV("",RCNAME)_"^"_$E(RCNAME,1)_$E(RCSSN,6,9)
S RCB=$$CSV(RCB,DOB)
S RCB=$$CSV(RCB,ELIG)
S RCB=$$CSV(RCB,"^")
S RCB=$$CSV(RCB,"First Party Charge")
S RCB=$$CSV(RCB,FPCBILL)
S RCB=$$CSV(RCB,"^")
S RCB=$$CSV(RCB,CHGTYP)
S RCB=$$CSV(RCB,STATUS)
S RCB=$$CSV(RCB,FILLFROM)
S RCB=$$CSV(RCB,FILLTO)
S RCB=$$CSV(RCB,"^")
S RCB=$$CSV(RCB,AMT)
S RCB=$$CSV(RCB,"^")
S RCB=$$CSV(RCB,BAL)
S RCB=$$CSV(RCB,"^")
S RCB=$$CSV(RCB,ONHOLD)
W !,RCB
Q
;
CSV(STRING,DATA) ; Build the Excel data string for CSV format
; Input: STRING - Current string being built or ""
; DATA - New data to be added to the string
; Returns: STRING - Updated string with DATA added
;
S DATA=""_$TR(DATA,$C(94))
S STRING=$S(STRING="":DATA,1:STRING_"^"_DATA)
Q STRING
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPRTEX 8790 printed Sep 23, 2025@19:22:30 Page 2
RCDPRTEX ;ALB/LMH - Claims Matching Report for Excel ;30-SEP 2016
+1 ;;4.5;Accounts Receivable;**315,339**;Mar 20, 1995;Build 2
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
PRINT ; Entry point for printing the Excel version of the report (either in foreground or background)
+1 ; Input:
+2 ; RCEXCEL=1 here
+3 ; Output:
+4 ; Report is printed in text format for Excel (turn on logging)
+5 ;
+6 USE IO
+7 KILL ^TMP("RCDPRTPB",$JOB),^TMP("IBRBT",$JOB),^TMP("IBRBF",$JOB)
+8 NEW DAT,RCBIL,RCBIL0,RCNAM,RCPAY,RCPAY1,RCREC,RCREC1,RCRECTDA,RCSSN,RCTYP,CRT,DIR,DIROUT,DIRUT,DTOUT,DUOUT
+9 NEW RCSTOP,PAGE,SEPLINE,X,XX,Y,RCNO
+10 ; 1 - Print to Screen, 0 - Otherwise
SET CRT=$SELECT(IOST["C-":1,1:0)
+11 IF '$DATA(ZTQUEUED)
USE 0
WRITE !!?5,"Compiling Claims Matching Report for Excel output. Please wait ... "
USE IO
+12 ;
+13 ; build the initial ^TMP("RCDPRTPB",$J) scratch global
+14 DO @($SELECT(RCSORT=1:"PAT",RCSORT=2:"BILL",RCSORT=3:"DATE",RCSORT=4:"REC",RCSORT=5:"TYPE")_"^RCDPRTP0")
+15 ;
+16 ; Long screen length for Excel output
SET IOSL=999999
+17 SET PAGE=0
SET RCSTOP=0
SET $PIECE(SEPLINE,"-",81)=""
+18 ;
+19 IF '$DATA(^TMP("RCDPRTPB",$JOB))
Begin DoDot:1
+20 ; initial form feed or page reset for no data found
if CRT
WRITE @IOF
if 'CRT
WRITE $CHAR(13)
+21 WRITE !!?5,"No data found for this report."
+22 IF CRT
IF '$DATA(ZTQUEUED)
SET DIR(0)="E"
DO ^DIR
KILL DIR
+23 DO ^%ZISC
+24 QUIT
End DoDot:1
QUIT
+25 ;
START ;
+1 NEW RCPAT0,NAME,BILLNUM,BILLFROM,BILLTO,RXCOV,RCIBFN,DOB,AMT,CHGTYP,STATUS
+2 NEW RCH,AMT1,PAYOR,PST,FILLFROM,FILLTO,ONHOLD,RCAMT,RCAMT1,RCIBDAT,STRING,RCBILL0
+3 NEW RCQ,RCSSN,RCTP,RCEXNAM,ELIG,FPCBILL,POSTDATE,RCDOB,RCFLAG,BAL,DATE,DEBTOR,RCDATE,RCDEBTOR,RCNAME
+4 DO EXCELHD
+5 ;
+6 SET RCNAM=""
FOR
SET RCNAM=$ORDER(^TMP("RCDPRTPB",$JOB,RCNAM))
if RCNAM=""
QUIT
Begin DoDot:1
+7 SET RCBILL=0
FOR
SET RCBILL=$ORDER(^TMP("RCDPRTPB",$JOB,RCNAM,RCBILL))
if 'RCBILL
QUIT
Begin DoDot:2
+8 DO DEMOG
+9 ; Process each third party bill for a patient.
DO PROC^RCDPRTP1
+10 KILL ^TMP("IBRBT",$JOB),^TMP("IBRBF",$JOB)
End DoDot:2
End DoDot:1
+11 ;
+12 DO ^%ZISC
+13 KILL ^TMP("RCDPRTPB",$JOB)
+14 QUIT
+15 ;
DEMOG ; Demographic data for third party bills &
+1 ; first party charges detail line header
+2 ;
+3 SET RCPAT0=$GET(^TMP("RCDPRTPB",$JOB,RCNAM))
+4 SET DATE=$GET(^TMP("RCDPRTPB",$JOB,RCNAM,RCBILL))
+5 SET RCNAME=$PIECE(RCNAM,"^")
+6 SET RCBILL0=$GET(^PRCA(430,RCBILL,0))
+7 SET RCDFN=$PIECE($GET(^PRCA(430,RCBILL,0)),U,7)
+8 SET RCDOB=$PIECE($GET(^DPT(RCDFN,0)),U,3)
+9 SET DOB=$$FMTE^XLFDT(RCDOB,"5Z")
+10 SET DEBTOR=$PIECE($GET(RCBILL0),U,9)
+11 SET RCDEBTOR=$ORDER(^RCD(340,"B",RCDFN_";DPT(",0))
if 'RCDEBTOR
QUIT
+12 SET RCSSN=$$SSN^RCFN01($GET(RCDEBTOR))
+13 SET ELIG=$PIECE($GET(RCPAT0),U,2)
+14 QUIT
+15 ;
PRNTPAT ; setup & print third party bills (called by PROC^RCDPRTP1 for Excel output only)
+1 SET RCTP=RCBILL
SET RCIBDAT=$GET(^TMP("IBRBT",$JOB,RCBILL,RCBILL))
+2 ;Added a last minute check for cancelled third party bills
SET STATUS=$$STAT^RCDPRTP2(RCTP)
if STATUS="CN"!(STATUS="CB")
QUIT
+3 SET RXCOV=$SELECT('$GET(^TMP("IBRBT",$JOB,RCBILL)):"NO",1:"YES")
+4 ; BILL #
SET BILLNUM=$PIECE(RCIBDAT,U,4)
+5 ; P/S/T
SET PST=$PIECE(RCIBDAT,U,5)
+6 ; bill date from
SET BILLFROM=$$DATE^RCDPRTP2($PIECE(RCIBDAT,U))
+7 ; bill date to
SET BILLTO=$$DATE^RCDPRTP2($PIECE(RCIBDAT,U,2))
+8 SET RCDATE=$SELECT($GET(RCTP(RCTP)):RCTP(RCTP),$GET(^TMP("RCDPRTPB",$JOB,RCNAM,RCBILL)):^(RCBILL),1:"")
IF RCTP=RCBILL!($DATA(RCTP(RCTP)))
SET POSTDATE=$$DATE^RCDPRTP2(RCDATE)
+9 SET RCIBFN=RCTP
+10 SET RCDATE=$PIECE($GET(^PRCA(430,+RCTP,0)),U,14)
+11 SET POSTDATE=$SELECT(RCDATE=DATE:$$DATE^RCDPRTP2(RCDATE),RCDATE'=DATE:"^")
+12 ; payor
SET PAYOR=$PIECE(RCIBDAT,U,7)
+13 ; amt billed
SET RCAMT=$PIECE($GET(^PRCA(430,+RCTP,0)),"^",3)
+14 ; amt paid
SET RCAMT1=$PIECE($GET(^PRCA(430,+RCTP,7)),"^",7)
+15 ;Third party bill type of care
SET RCTYPE=$$TYP^IBRFN(RCTP)
+16 SET RCTYPE=$SELECT(RCTYPE="":-1,RCTYPE="PR":"P",RCTYPE="PH":"R",1:RCTYPE)
+17 SET RCFLAG=RCTYPE
+18 SET RCTP=RCBILL
+19 DO EXCELPAT
+20 ;
EXCELTPB ; print other assoc. third party bills
+1 SET RCTP=0
FOR
SET RCTP=$ORDER(^TMP("IBRBT",$JOB,RCBILL,RCTP))
if 'RCTP
QUIT
Begin DoDot:1
+2 ;Added a last minute check for cancelled third party bills
SET STATUS=$$STAT^RCDPRTP2(RCTP)
if STATUS="CN"!(STATUS="CB")
QUIT
+3 ; don't reprint the bill that was paid.
IF RCBILL=RCTP
QUIT
+4 SET RCIBDAT=$GET(^TMP("IBRBT",$JOB,RCBILL,RCTP))
+5 ; exclude cancelled bills
IF 'RCAN
IF ($PIECE(RCIBDAT,"^",3))
QUIT
+6 DO DEMOG
+7 SET RXCOV=$SELECT('$GET(^TMP("IBRBT",$JOB,RCBILL)):"NO",1:"YES")
+8 ; BILL #
SET BILLNUM=$PIECE(RCIBDAT,U,4)
+9 ; P/S/T
SET PST=$PIECE(RCIBDAT,U,5)
+10 ; bill date from
SET BILLFROM=$$DATE^RCDPRTP2($PIECE(RCIBDAT,U))
+11 ; bill date to
SET BILLTO=$$DATE^RCDPRTP2($PIECE(RCIBDAT,U,2))
+12 SET RCDATE=$PIECE($GET(^PRCA(430,+RCTP,0)),U,14)
+13 SET POSTDATE=$SELECT(RCDATE=DATE:$$DATE^RCDPRTP2(RCDATE),RCDATE'=DATE:"^")
+14 SET RCIBFN=RCTP
+15 ; payor
SET PAYOR=$PIECE(RCIBDAT,U,7)
+16 ; amt billed
SET RCAMT=$PIECE($GET(^PRCA(430,+RCTP,0)),"^",3)
+17 ; amt paid
SET RCAMT1=$PIECE($GET(^PRCA(430,+RCTP,7)),"^",7)
+18 ;Third party bill type of care
SET RCTYPE=$$TYP^IBRFN(RCTP)
+19 SET RCTYPE=$SELECT(RCTYPE="":-1,RCTYPE="PR":"P",RCTYPE="PH":"R",1:RCTYPE)
+20 DO EXCELPAT
End DoDot:1
+21 ;
PRNTFPC ; print associated first party charges
+1 ; This code screens entries from file 350.1 returned by API - RELBILL^IBRFN
+2 ;Do the next section of code only if Care Types were selected - Stored in RCTYPE([care type])
NEW RCACTYP,I,J
+3 ; We must loop through all Bills and First party charges for this screening
+4 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
+5 ;6th piece is Action Type
SET RCACTYP=$PIECE(^TMP("IBRBF",$JOB,I,J),U,6)
if RCACTYP=""
QUIT
+6 ;Not needed for screening 1st party charges
IF RCACTYP["TRICARE"!(RCACTYP["CHAMPA")
QUIT
+7 IF RCACTYP["RX"
SET RCTYP="R"
DO KILFPTY^RCDPRTP1
QUIT
+8 IF RCACTYP["OPT"!(RCACTYP["OBSERV")
SET RCTYP="O"
DO KILFPTY^RCDPRTP1
QUIT
+9 IF RCACTYP["INPT"!(RCACTYP["NHCU")!(RCACTYP["ADMIS")!(RCACTYP["MEDICARE DECUCTIBLE")
SET RCTYP="I"
DO KILFPTY^RCDPRTP1
QUIT
+10 QUIT
End DoDot:1
+11 ;
+12 SET RCTP(0)=0
FOR
SET RCTP(0)=$ORDER(^TMP("IBRBF",$JOB,RCTP(0)))
if 'RCTP(0)!$GET(RCQ)
QUIT
Begin DoDot:1
+13 SET RCTP=0
FOR
SET RCTP=$ORDER(^TMP("IBRBF",$JOB,RCTP(0),RCTP))
if 'RCTP!$GET(RCQ)
QUIT
Begin DoDot:2
+14 SET RCNO=1
+15 SET RCIBDAT=$GET(^TMP("IBRBF",$JOB,RCTP(0),RCTP))
+16 SET RCIBFN=$PIECE(RCIBDAT,U,4)
IF RCIBFN
SET RCIBFN=$ORDER(^PRCA(430,"B",RCIBFN,0))
+17 DO DEMOG
+18 SET RXCOV=$SELECT('$GET(^TMP("IBRBT",$JOB,RCBILL)):"NO",1:"YES")
+19 ; Bill from
SET FILLFROM=$$DATE^RCDPRTP2(+RCIBDAT)
+20 ; Bill to
SET FILLTO=$$DATE^RCDPRTP2($PIECE(RCIBDAT,U,2))
+21 SET CHGTYP=$PIECE(RCIBDAT,U,6)
+22 SET RCIBFN=$PIECE(RCIBDAT,"^",4)
IF RCIBFN
SET RCIBFN=$ORDER(^PRCA(430,"B",RCIBFN,0))
+23 SET FPCBILL=$PIECE(RCIBDAT,U,4)
+24 ; Status
SET STATUS=$$STAT^RCDPRTP2(RCIBFN)
+25 ; # Days On Hold
SET ONHOLD=$PIECE(RCIBDAT,U,7)
+26 ; Amount billed
SET AMT=$PIECE(RCIBDAT,U,5)
+27 SET BAL=$SELECT($GET(^PRCA(430,+RCIBFN,7)):+($PIECE(^(7),"^")+$PIECE(^(7),"^",2)+$PIECE(^(7),"^",3)+$PIECE(^(7),"^",4)+$PIECE(^(7),"^",4)),1:0)
+28 DO EXCELFPC
End DoDot:2
+29 QUIT
End DoDot:1
+30 QUIT
+31 ;
EXCELHD ; Print an Excel CSV header record
+1 ;
+2 ; Input: None
+3 ; Output: Header line printed for CSV format (excel)
+4 ;
+5 ; initial form feed or page reset for Excel header line
if CRT
WRITE @IOF
if 'CRT
WRITE $CHAR(13)
+6 NEW RCH
+7 SET STRING=""
+8 SET RCH=$$CSV("","Patient")
+9 SET RCH=$$CSV(RCH,"SSN")
+10 SET RCH=$$CSV(RCH,"DOB")
+11 SET RCH=$$CSV(RCH,"Prim. Elig")
+12 SET RCH=$$CSV(RCH,"RX Cvg")
+13 SET RCH=$$CSV(RCH,"Bill Type")
+14 SET RCH=$$CSV(RCH,"Bill#")
+15 SET RCH=$$CSV(RCH,"P/S/T")
+16 SET RCH=$$CSV(RCH,"Chg Type")
+17 SET RCH=$$CSV(RCH,"Status")
+18 SET RCH=$$CSV(RCH,"Bill From")
+19 SET RCH=$$CSV(RCH,"Bill To")
+20 SET RCH=$$CSV(RCH,"Posted")
+21 SET RCH=$$CSV(RCH,"Amt Billed")
+22 SET RCH=$$CSV(RCH,"Amt Pd")
+23 SET RCH=$$CSV(RCH,"Bal")
+24 SET RCH=$$CSV(RCH,"Care Type")
+25 SET RCH=$$CSV(RCH,"On Hold")
+26 SET RCH=$$CSV(RCH,"Payor")
+27 WRITE RCH
+28 QUIT
+29 ;
EXCELPAT ; Print patient third party bills
+1 ;
+2 ; Input: None
+3 ; Output: Detail line printed for CSV format (excel)
+4 ;
+5 NEW RCD
+6 SET STRING=""
+7 SET RCD=$$CSV("",RCNAME)_"^"_$EXTRACT(RCNAME,1)_$EXTRACT(RCSSN,6,9)
+8 SET RCD=$$CSV(RCD,DOB)
+9 SET RCD=$$CSV(RCD,ELIG)
+10 SET RCD=$$CSV(RCD,RXCOV)
+11 SET RCD=$$CSV(RCD,"Third Party Bill")
+12 SET RCD=$$CSV(RCD,BILLNUM)
+13 SET RCD=$$CSV(RCD,PST)
+14 SET RCD=$$CSV(RCD,"^")
+15 SET RCD=$$CSV(RCD,STATUS)
+16 SET RCD=$$CSV(RCD,BILLFROM)
+17 SET RCD=$$CSV(RCD,BILLTO)
+18 SET RCD=$$CSV(RCD,POSTDATE)
+19 SET RCD=$$CSV(RCD,RCAMT)
+20 SET RCD=$$CSV(RCD,RCAMT1)
+21 SET RCD=$$CSV(RCD,"^")
+22 SET RCD=$$CSV(RCD,RCTYPE)
+23 SET RCD=$$CSV(RCD,"^")
+24 SET RCD=$$CSV(RCD,PAYOR)
+25 WRITE !,RCD
+26 KILL RCTP(RCTP)
+27 QUIT
+28 ;
EXCELFPC ; Print patient first party charges
+1 ;
+2 ; Input: None
+3 ; Output: Detail line printed for CSV format (excel)
+4 ;
+5 NEW RCB
+6 SET STRING=""
+7 SET RCB=$$CSV("",RCNAME)_"^"_$EXTRACT(RCNAME,1)_$EXTRACT(RCSSN,6,9)
+8 SET RCB=$$CSV(RCB,DOB)
+9 SET RCB=$$CSV(RCB,ELIG)
+10 SET RCB=$$CSV(RCB,"^")
+11 SET RCB=$$CSV(RCB,"First Party Charge")
+12 SET RCB=$$CSV(RCB,FPCBILL)
+13 SET RCB=$$CSV(RCB,"^")
+14 SET RCB=$$CSV(RCB,CHGTYP)
+15 SET RCB=$$CSV(RCB,STATUS)
+16 SET RCB=$$CSV(RCB,FILLFROM)
+17 SET RCB=$$CSV(RCB,FILLTO)
+18 SET RCB=$$CSV(RCB,"^")
+19 SET RCB=$$CSV(RCB,AMT)
+20 SET RCB=$$CSV(RCB,"^")
+21 SET RCB=$$CSV(RCB,BAL)
+22 SET RCB=$$CSV(RCB,"^")
+23 SET RCB=$$CSV(RCB,ONHOLD)
+24 WRITE !,RCB
+25 QUIT
+26 ;
CSV(STRING,DATA) ; Build the Excel data string for CSV format
+1 ; Input: STRING - Current string being built or ""
+2 ; DATA - New data to be added to the string
+3 ; Returns: STRING - Updated string with DATA added
+4 ;
+5 SET DATA=""_$TRANSLATE(DATA,$CHAR(94))
+6 SET STRING=$SELECT(STRING="":DATA,1:STRING_"^"_DATA)
+7 QUIT STRING
+8 ;
