- 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 Mar 13, 2025@20:51:02 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 ;
