FBPCR671 ;AISC/DMK,TET-CH/CNH POTENTIAL COST RECOVERY PRINT ;7/18/2006
;;3.5;FEE BASIS;**4,48,55,69,76,98,122,108,163**;JAN 30, 1995;Build 21
;Per VA Directive 6402, this routine should not be modified.
;
PRINT ;print data from tmp global
N FBBILL,FBINAU ; FB*3.5*163
I FBPG>1&(($Y+12)>IOSL) D HDR Q:FBOUT
E D HDR1 Q:FBOUT
S FBPVLIST="ATTENDING PROV NAME^NPI^TAXONOMY CODE^OPERATING PROV NAME^NPI^RENDERING PROV NAME"
S FBPVLIST=FBPVLIST_"^NPI^TAXONOMY CODE^SERVICING PROV NAME^NPI^REFERRING PROV NAME^NPI"
S FBVI="" F S FBVI=$O(^TMP($J,"FB",FBPSF,FBPT,FBPI,FBVI)) Q:FBVI']""!(FBOUT) D SH Q:FBOUT D Q:FBOUT
.S FBDT=0 F S FBDT=$O(^TMP($J,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT)) Q:'FBDT S FBI=0 F S FBI=$O(^TMP($J,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,FBI)) Q:'FBI D Q:FBOUT
..I ($Y+5)>IOSL D PAGE Q:FBOUT
..S FBDATA=$G(^TMP($J,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,FBI)),FBCATC=$P(FBDATA,U,9),FBINS=$P(FBDATA,U,10) ;FB*3.5*163 Add $G
..S FBINV=$G(^TMP($J,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,FBI,"FBINV")) ; FB*3.5*163 Add $G
..S FBBILL=$G(^TMP($J,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,FBI,"FBBILL")) ; FB*3.5*163 Bill No.
..S FBINAU=$G(^TMP($J,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,FBI,"FBINAU")) ; FB*3.5*163 Ins Auth No.
..W ! W:$P(FBDATA,U,8)["R" "*" W:$P(FBDATA,U,9)]"" "#"
..W ?2,$P(FBDATA,U,1),?15,$P(FBDATA,U,5),?31,$P(FBDATA,U,6)
..W ?47,$P(FBDATA,U,7),?57,$P(FBINV,U,2)
..W !?2,$P(FBDATA,U,2),?15,$P(FBDATA,U,3),?25,$P(FBINV,U,1)
.. ;Print adj reasons, if null then print suspend code
..W ?36,$S($P(FBINV,U,3)]"":$P(FBINV,U,3),1:$P(FBDATA,U,4))
..W ?46,$S($P(FBINV,U,3)]"":$J($P(FBINV,U,4),14),1:$J($P(FBDATA,U,10),14))
..W ?63,$P(FBINV,U,5)
..W !,?2,$S(FBBILL:"Y",1:"N"),?9,FBBILL ; FB*3.5*163 Bill No.
..W ?24,FBINAU ; FB*3.5*163 Ins Auth No.
..; write admitting diagnosis if present
.. I $P(FBINV,U,6)'="" W !?6,"Admit Dx: ",$P(FBINV,U,6)
..;F FBY="DX","PROC" I $D(^TMP($J,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,FBI,FBY)) S FBDATA=^(FBY),FBSL=$L(FBDATA,"^") W !?2,FBY,": " F I=1:1:FBSL W $P(FBDATA,U,I)," "
..I $D(^TMP($J,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,FBI,"DX")) S FBDATA=$G(^TMP($J,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,FBI,"DX")),FBSL=$L(FBDATA,"^") F I=1:1:FBSL D WRTDX
..S FBNEWLN=1
..I $D(^TMP($J,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,FBI,"PROC")) S FBDATA=$G(^TMP($J,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,FBI,"PROC")),FBSL=$L(FBDATA,"^") F I=1:1:FBSL D WRTPC
..K FBNEWLN
..;I FBDATA]"" F I=1:1:FBSL I $P(FBDATA,U,I)]"" D ; FB*3.5*122
..;.;W:FBRPROV !,?2,"PROC: " W:$G(FBRPROV)="" " " W $P(FBDATA,U,I) ; FB*3.5*122
..;.;S FBRPROV=$G(^TMP($J,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,FBI,"RPROV",I)) I FBRPROV="" Q ; FB*3.5*122
..;.;W ?20,"RENDERING PROVIDER NAME: "_$P(FBRPROV,U,2),!,?21,"NPI: "_$P(FBRPROV,U,3),?46,"TAXONOMY CODE: "_$P(FBRPROV,U,4) S FBRPROV=1 ; FB*3.5*122
..K FBRPROV
..I FBCATC!FBINS D
...W !?5,">>>"
...I FBCATC=0 W "Cost recover from insurance."
...I FBCATC=1 W "Cost recover from means testing"_$S(FBINS:" and insurance.",1:".")
...I FBCATC=2 W "Cost recover from LTC co-pay"_$S(FBINS:" and insurance.",1:".")
...I FBCATC=3 W $S(FBINS:"Cost recover from insurance, ",1:"")_"1010EC Missing for LTC Patient."
...I FBCATC=4 W $S(FBINS:"Cost Recover from insurance and ",1:"")_"Potential Cost Recover from LTC co-pay."
..;
..I +$O(^TMP($J,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,FBI,"A",0)) D Q:FBOUT W !,FBDASH1
...S (FBOV,FBCNT)=0,FBSL=7 D SHA Q:FBOUT
...F S FBCNT=$O(^TMP($J,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,FBI,"A",FBCNT)) Q:'FBCNT S FBDATA=^(FBCNT),FBV=$P(FBDATA,U,11)_";"_$P(FBDATA,U,12) D D WRT Q:FBOUT
....N FBXX S FBXX=$O(^FBAAV("C",$P(FBDATA,U,12),"")) S $P(FBV,";",2)=$P(FBV,";",2)_"/"_$S(FBXX="":"**********",$P($G(^FBAAV(FBXX,3)),U,2)]"":$P(^FBAAV(FBXX,3),U,2),1:"**********")
..D PRNT5010 ; FB*3.5*122
..W ! D PRTAUTH^FBPCR2(FBI) ;FB*3.5*163
Q
PRNT5010 ; Format and print based on data type ; FB*3.5*122
N FBVDAT,FBCNT
I $G(FBPSF)]"",$G(FBPT)]"",$G(FBPI)]"",$G(FBVI)]"",$G(FBDT)]"",$G(FBI)]"",$G(^TMP($J,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,FBI,"FBY4"))]""
E Q
W ! S FBVDAT=^TMP($J,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,FBI,"FBY4")
F FBCNT=1,6 I $P(FBVDAT,U,FBCNT)]"" D
. W !,$P(FBPVLIST,U,FBCNT)_": "_$P(FBVDAT,U,FBCNT),?55,$P(FBPVLIST,U,FBCNT+1)_": "_$P(FBVDAT,U,FBCNT+1)
. W !,?6,$P(FBPVLIST,U,FBCNT+2)_": "_$P(FBVDAT,U,FBCNT+2)
F FBCNT=4,11,9 I $P(FBVDAT,U,FBCNT)]"" D
. W !,$P(FBPVLIST,U,FBCNT)_": "_$P(FBVDAT,U,FBCNT),?55,$P(FBPVLIST,U,FBCNT+1)_": "_$P(FBVDAT,U,FBCNT+1)
I $P(FBVDAT,U,20)]"" D
. W !," SERVICING FACILITY ADDRESS: "_$P(FBVDAT,U,20),!," "_$P(FBVDAT,U,21)_", "
. I $P(FBVDAT,U,22)]"" W $$GET1^DIQ(5,$P(FBVDAT,U,22)_",",.01)
. W " "_$P(FBVDAT,U,23)
W !
Q
WRT ;write ancillary info
N FBCATC,FBINS,FBADJ I ($Y+4)>IOSL D PAGE Q:FBOUT D SHA,SHA2
D:FBOV'=FBV SHA2
S FBADJ=^TMP($J,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,FBI,"A",FBCNT,"FBADJ")
S FBCATC=$P(FBDATA,U,14),FBINS=$P(FBDATA,U,15)
W !
W ?1,$P(FBDATA,U,1)
W ?11,$P($P(FBDATA,U,2),",")
W ?31,$J($P(FBADJ,U,2),10)
W ?43,$P(FBDATA,U,6)
W ?54,$P(FBDATA,U,7)
W ?64,$P(FBDATA,U,8)
I $P($P(FBDATA,U,2),",",2)]"" D Q:FBOUT
. N FBI,FBMOD
. F FBI=2:1 S FBMOD=$P($P(FBDATA,U,2),",",FBI) Q:FBMOD="" D Q:FBOUT
. . I $Y+6>IOSL D PAGE Q:FBOUT D SHA,SHA2 W !," (continued)"
. . W !,?16,"-",FBMOD
W !,$P(FBDATA,U,3)
W ?13,$P(FBDATA,U,4)
W ?23,$S($P(FBADJ,U,3)]"":$P(FBADJ,U,3),1:$P(FBDATA,U,5))
W ?33,$J($S($P(FBADJ,U,4)]"":$J($P(FBADJ,U,4),14),1:$P(FBADJ,U,1)),14)
W ?48,$P(FBADJ,U,5)
W ?60,$P(FBADJ,U,6)
W !?5,"Primary Dx: ",$P(FBDATA,U,9),?40,"S/C Condition? ",$P(FBDATA,U,8),?66,"Obl.#: ",$P(FBDATA,U,10)
I FBCATC!FBINS D
.W !?5,">>>"
.I FBCATC=0 W "Cost recover from insurance."
.I FBCATC=1 W "Cost recover from means testing"_$S(FBINS:" and insurance.",1:".")
.I FBCATC=2 W "Cost recover from LTC co-pay"_$S(FBINS:" and insurance.",1:".")
.I FBCATC=3 W $S(FBINS:"Cost recover from insurance, ",1:"")_"1010EC Missing for LTC Patient."
.I FBCATC=4 W $S(FBINS:"Cost Recover from insurance and ",1:"")_"Potential Cost Recover from LTC co-pay."
;
Q
HDR ;main header
D HDR^FBPCR Q:FBOUT
HDR1 W !!?(IOM-(13+$L(FBXPROG))/2),"NVC PROGRAM: ",FBXPROG ;FB*3.5*163 - Changed from FEE to NVC
W !?1,"Invoice Date",?15,"Invoice No.",?31,"From Date",?48,"To Date",?57,"Patient Control #"
; W !?1,"Amt Claimed",?15,"Amt Paid",?25,"Cov Days",?36,"Adj Codes",?49,"Adj Amounts",?63,"Remit Remarks",!,FBDASH
W !?1,"Amt Claimed",?15,"Amt Paid",?25,"Cov Days",?36,"Adj Codes",?49,"Adj Amounts",?63,"Remit Remarks" ; FB*3.5*163
W !?1,"Billed?",?9,"Bill#",?24,"Ins Auth#",!,FBDASH ;FB*3.5*163
Q
SH ;subheader - vendor, prints when name changed
I ($Y+7)>IOSL D HDR Q:FBOUT
W !!,"Vendor: ",$P(FBVI,";"),?41,"Vendor ID: ",$P($P(FBVI,";",2),"/",1)
W !?20,"Fee Basis Billing Provider NPI: ",$P(FBVI,"/",2)
Q
SHA ;ancillary subheader
I ($Y+16)>IOSL D PAGE Q:FBOUT
W !?20,">>> ANCILLARY SERVICE PAYMENTS <<<",!
SHA1 ;subheader for ancillary data
W !!,?1,"Svc Date",?11,"CPT-MOD ",?19,"Travel Paid",?31,"Units Paid",?43,"Batch No.",?54,"Inv No.",?64,"Voucher Date"
W !,"Amt Claimed",?13,"Amt Paid",?23,"Adj Code",?36,"Adj Amounts",?48,"Remit Remark",?61,"Patient Account No",!,FBDASH
Q
SHA2 ;subheader for vendor name
I ($Y+9)>IOSL D HDR Q:FBOUT D SH,SHA
I FBOV'=FBV S FBOV=FBV
W !!,"Vendor: ",$P(FBV,";"),?41,"Vendor ID/NPI: ",$P(FBV,";",2)
Q
CR ;read for display
Q:'FBPG S DIR(0)="E" W ! D ^DIR K DIR S:$D(DUOUT)!($D(DTOUT)) FBOUT=1
Q
PAGE ;new page
D HDR Q:FBOUT D SH
Q
WRTDX ;input
; FBDATA contains node from ^TMP
; I contains piece to be written
I I=1!($X+$L($P(FBDATA,"^",I))+1>IOM) W !,?4,"DX/POA: "
W $P(FBDATA,"^",I)," "
Q
WRTPC ;input
;FBDATA contains node from ^TMP
;I contains piece to be written
; if FBNEWLN true then force new line and label for procedure
N FBRPROV
S FBRPROV=$G(^TMP($J,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,FBI,"RPROV",I))
; start new line for procedures when appropriate
I FBRPROV'="" S FBNEWLN=1
I FBNEWLN!($X+$L($P(FBDATA,"^",I))+2>IOM) W !?4,"PROC: " S FBNEWLN=0
; write procedure code
W $P(FBDATA,"^",I)," "
; write line rendering provider data if applicable
I FBRPROV="" Q
W ?20,"RENDERING PROVIDER NAME: "_$P(FBRPROV,U,2)
W !?21,"NPI: "_$P(FBRPROV,U,3)
W ?46,"TAXONOMY CODE: "_$P(FBRPROV,U,4)
S FBNEWLN=1 ; force new line for next procedure
Q
;I I=1!($X+$L($P(FBDATA,"^",I))+1>IOM) W !,?4,"PROC: "
;W $P(FBDATA,"^",I)," "
;Q
;S FBRPROV=$G(^TMP($J,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,FBI,"RPROV",I)) ; FB*3.5*122
;W !,?2,"PROC: ",$P(FBDATA,U,I) I FBRPROV="" Q ; FB*3.5*122
;W ?20,"RENDERING PROVIDER NAME: "_$P(FBRPROV,U,2),!,?21,"NPI: "_$P(FBRPROV,U,3),?46,"TAXONOMY CODE: "_$P(FBRPROV,U,4) S FBRPROV=1 ; FB*3.5*122
;Q
WRTSC ;write service connected
W !,"SERVICE CONNECTED? ",$S(+VAEL(3):"YES",1:"NO"),!
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBPCR671 9223 printed Sep 23, 2025@19:35:44 Page 2
FBPCR671 ;AISC/DMK,TET-CH/CNH POTENTIAL COST RECOVERY PRINT ;7/18/2006
+1 ;;3.5;FEE BASIS;**4,48,55,69,76,98,122,108,163**;JAN 30, 1995;Build 21
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
PRINT ;print data from tmp global
+1 ; FB*3.5*163
NEW FBBILL,FBINAU
+2 IF FBPG>1&(($Y+12)>IOSL)
DO HDR
if FBOUT
QUIT
+3 IF '$TEST
DO HDR1
if FBOUT
QUIT
+4 SET FBPVLIST="ATTENDING PROV NAME^NPI^TAXONOMY CODE^OPERATING PROV NAME^NPI^RENDERING PROV NAME"
+5 SET FBPVLIST=FBPVLIST_"^NPI^TAXONOMY CODE^SERVICING PROV NAME^NPI^REFERRING PROV NAME^NPI"
+6 SET FBVI=""
FOR
SET FBVI=$ORDER(^TMP($JOB,"FB",FBPSF,FBPT,FBPI,FBVI))
if FBVI']""!(FBOUT)
QUIT
DO SH
if FBOUT
QUIT
Begin DoDot:1
+7 SET FBDT=0
FOR
SET FBDT=$ORDER(^TMP($JOB,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT))
if 'FBDT
QUIT
SET FBI=0
FOR
SET FBI=$ORDER(^TMP($JOB,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,FBI))
if 'FBI
QUIT
Begin DoDot:2
+8 IF ($Y+5)>IOSL
DO PAGE
if FBOUT
QUIT
+9 ;FB*3.5*163 Add $G
SET FBDATA=$GET(^TMP($JOB,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,FBI))
SET FBCATC=$PIECE(FBDATA,U,9)
SET FBINS=$PIECE(FBDATA,U,10)
+10 ; FB*3.5*163 Add $G
SET FBINV=$GET(^TMP($JOB,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,FBI,"FBINV"))
+11 ; FB*3.5*163 Bill No.
SET FBBILL=$GET(^TMP($JOB,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,FBI,"FBBILL"))
+12 ; FB*3.5*163 Ins Auth No.
SET FBINAU=$GET(^TMP($JOB,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,FBI,"FBINAU"))
+13 WRITE !
if $PIECE(FBDATA,U,8)["R"
WRITE "*"
if $PIECE(FBDATA,U,9)]""
WRITE "#"
+14 WRITE ?2,$PIECE(FBDATA,U,1),?15,$PIECE(FBDATA,U,5),?31,$PIECE(FBDATA,U,6)
+15 WRITE ?47,$PIECE(FBDATA,U,7),?57,$PIECE(FBINV,U,2)
+16 WRITE !?2,$PIECE(FBDATA,U,2),?15,$PIECE(FBDATA,U,3),?25,$PIECE(FBINV,U,1)
+17 ;Print adj reasons, if null then print suspend code
+18 WRITE ?36,$SELECT($PIECE(FBINV,U,3)]"":$PIECE(FBINV,U,3),1:$PIECE(FBDATA,U,4))
+19 WRITE ?46,$SELECT($PIECE(FBINV,U,3)]"":$JUSTIFY($PIECE(FBINV,U,4),14),1:$JUSTIFY($PIECE(FBDATA,U,10),14))
+20 WRITE ?63,$PIECE(FBINV,U,5)
+21 ; FB*3.5*163 Bill No.
WRITE !,?2,$SELECT(FBBILL:"Y",1:"N"),?9,FBBILL
+22 ; FB*3.5*163 Ins Auth No.
WRITE ?24,FBINAU
+23 ; write admitting diagnosis if present
+24 IF $PIECE(FBINV,U,6)'=""
WRITE !?6,"Admit Dx: ",$PIECE(FBINV,U,6)
+25 ;F FBY="DX","PROC" I $D(^TMP($J,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,FBI,FBY)) S FBDATA=^(FBY),FBSL=$L(FBDATA,"^") W !?2,FBY,": " F I=1:1:FBSL W $P(FBDATA,U,I)," "
+26 IF $DATA(^TMP($JOB,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,FBI,"DX"))
SET FBDATA=$GET(^TMP($JOB,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,FBI,"DX"))
SET FBSL=$LENGTH(FBDATA,"^")
FOR I=1:1:FBSL
DO WRTDX
+27 SET FBNEWLN=1
+28 IF $DATA(^TMP($JOB,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,FBI,"PROC"))
SET FBDATA=$GET(^TMP($JOB,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,FBI,"PROC"))
SET FBSL=$LENGTH(FBDATA,"^")
FOR I=1:1:FBSL
DO WRTPC
+29 KILL FBNEWLN
+30 ;I FBDATA]"" F I=1:1:FBSL I $P(FBDATA,U,I)]"" D ; FB*3.5*122
+31 ;.;W:FBRPROV !,?2,"PROC: " W:$G(FBRPROV)="" " " W $P(FBDATA,U,I) ; FB*3.5*122
+32 ;.;S FBRPROV=$G(^TMP($J,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,FBI,"RPROV",I)) I FBRPROV="" Q ; FB*3.5*122
+33 ;.;W ?20,"RENDERING PROVIDER NAME: "_$P(FBRPROV,U,2),!,?21,"NPI: "_$P(FBRPROV,U,3),?46,"TAXONOMY CODE: "_$P(FBRPROV,U,4) S FBRPROV=1 ; FB*3.5*122
+34 KILL FBRPROV
+35 IF FBCATC!FBINS
Begin DoDot:3
+36 WRITE !?5,">>>"
+37 IF FBCATC=0
WRITE "Cost recover from insurance."
+38 IF FBCATC=1
WRITE "Cost recover from means testing"_$SELECT(FBINS:" and insurance.",1:".")
+39 IF FBCATC=2
WRITE "Cost recover from LTC co-pay"_$SELECT(FBINS:" and insurance.",1:".")
+40 IF FBCATC=3
WRITE $SELECT(FBINS:"Cost recover from insurance, ",1:"")_"1010EC Missing for LTC Patient."
+41 IF FBCATC=4
WRITE $SELECT(FBINS:"Cost Recover from insurance and ",1:"")_"Potential Cost Recover from LTC co-pay."
End DoDot:3
+42 ;
+43 IF +$ORDER(^TMP($JOB,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,FBI,"A",0))
Begin DoDot:3
+44 SET (FBOV,FBCNT)=0
SET FBSL=7
DO SHA
if FBOUT
QUIT
+45 FOR
SET FBCNT=$ORDER(^TMP($JOB,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,FBI,"A",FBCNT))
if 'FBCNT
QUIT
SET FBDATA=^(FBCNT)
SET FBV=$PIECE(FBDATA,U,11)_";"_$PIECE(FBDATA,U,12)
Begin DoDot:4
+46 NEW FBXX
SET FBXX=$ORDER(^FBAAV("C",$PIECE(FBDATA,U,12),""))
SET $PIECE(FBV,";",2)=$PIECE(FBV,";",2)_"/"_$SELECT(FBXX="":"**********",$PIECE($GET(^FBAAV(FBXX,3)),U,2)]"":$PIECE(^FBAAV(FBXX,3),U,2),1:"**********")
End DoDot:4
DO WRT
if FBOUT
QUIT
End DoDot:3
if FBOUT
QUIT
WRITE !,FBDASH1
+47 ; FB*3.5*122
DO PRNT5010
+48 ;FB*3.5*163
WRITE !
DO PRTAUTH^FBPCR2(FBI)
End DoDot:2
if FBOUT
QUIT
End DoDot:1
if FBOUT
QUIT
+49 QUIT
PRNT5010 ; Format and print based on data type ; FB*3.5*122
+1 NEW FBVDAT,FBCNT
+2 IF $GET(FBPSF)]""
IF $GET(FBPT)]""
IF $GET(FBPI)]""
IF $GET(FBVI)]""
IF $GET(FBDT)]""
IF $GET(FBI)]""
IF $GET(^TMP($JOB,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,FBI,"FBY4"))]""
+3 IF '$TEST
QUIT
+4 WRITE !
SET FBVDAT=^TMP($JOB,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,FBI,"FBY4")
+5 FOR FBCNT=1,6
IF $PIECE(FBVDAT,U,FBCNT)]""
Begin DoDot:1
+6 WRITE !,$PIECE(FBPVLIST,U,FBCNT)_": "_$PIECE(FBVDAT,U,FBCNT),?55,$PIECE(FBPVLIST,U,FBCNT+1)_": "_$PIECE(FBVDAT,U,FBCNT+1)
+7 WRITE !,?6,$PIECE(FBPVLIST,U,FBCNT+2)_": "_$PIECE(FBVDAT,U,FBCNT+2)
End DoDot:1
+8 FOR FBCNT=4,11,9
IF $PIECE(FBVDAT,U,FBCNT)]""
Begin DoDot:1
+9 WRITE !,$PIECE(FBPVLIST,U,FBCNT)_": "_$PIECE(FBVDAT,U,FBCNT),?55,$PIECE(FBPVLIST,U,FBCNT+1)_": "_$PIECE(FBVDAT,U,FBCNT+1)
End DoDot:1
+10 IF $PIECE(FBVDAT,U,20)]""
Begin DoDot:1
+11 WRITE !," SERVICING FACILITY ADDRESS: "_$PIECE(FBVDAT,U,20),!," "_$PIECE(FBVDAT,U,21)_", "
+12 IF $PIECE(FBVDAT,U,22)]""
WRITE $$GET1^DIQ(5,$PIECE(FBVDAT,U,22)_",",.01)
+13 WRITE " "_$PIECE(FBVDAT,U,23)
End DoDot:1
+14 WRITE !
+15 QUIT
WRT ;write ancillary info
+1 NEW FBCATC,FBINS,FBADJ
IF ($Y+4)>IOSL
DO PAGE
if FBOUT
QUIT
DO SHA
DO SHA2
+2 if FBOV'=FBV
DO SHA2
+3 SET FBADJ=^TMP($JOB,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,FBI,"A",FBCNT,"FBADJ")
+4 SET FBCATC=$PIECE(FBDATA,U,14)
SET FBINS=$PIECE(FBDATA,U,15)
+5 WRITE !
+6 WRITE ?1,$PIECE(FBDATA,U,1)
+7 WRITE ?11,$PIECE($PIECE(FBDATA,U,2),",")
+8 WRITE ?31,$JUSTIFY($PIECE(FBADJ,U,2),10)
+9 WRITE ?43,$PIECE(FBDATA,U,6)
+10 WRITE ?54,$PIECE(FBDATA,U,7)
+11 WRITE ?64,$PIECE(FBDATA,U,8)
+12 IF $PIECE($PIECE(FBDATA,U,2),",",2)]""
Begin DoDot:1
+13 NEW FBI,FBMOD
+14 FOR FBI=2:1
SET FBMOD=$PIECE($PIECE(FBDATA,U,2),",",FBI)
if FBMOD=""
QUIT
Begin DoDot:2
+15 IF $Y+6>IOSL
DO PAGE
if FBOUT
QUIT
DO SHA
DO SHA2
WRITE !," (continued)"
+16 WRITE !,?16,"-",FBMOD
End DoDot:2
if FBOUT
QUIT
End DoDot:1
if FBOUT
QUIT
+17 WRITE !,$PIECE(FBDATA,U,3)
+18 WRITE ?13,$PIECE(FBDATA,U,4)
+19 WRITE ?23,$SELECT($PIECE(FBADJ,U,3)]"":$PIECE(FBADJ,U,3),1:$PIECE(FBDATA,U,5))
+20 WRITE ?33,$JUSTIFY($SELECT($PIECE(FBADJ,U,4)]"":$JUSTIFY($PIECE(FBADJ,U,4),14),1:$PIECE(FBADJ,U,1)),14)
+21 WRITE ?48,$PIECE(FBADJ,U,5)
+22 WRITE ?60,$PIECE(FBADJ,U,6)
+23 WRITE !?5,"Primary Dx: ",$PIECE(FBDATA,U,9),?40,"S/C Condition? ",$PIECE(FBDATA,U,8),?66,"Obl.#: ",$PIECE(FBDATA,U,10)
+24 IF FBCATC!FBINS
Begin DoDot:1
+25 WRITE !?5,">>>"
+26 IF FBCATC=0
WRITE "Cost recover from insurance."
+27 IF FBCATC=1
WRITE "Cost recover from means testing"_$SELECT(FBINS:" and insurance.",1:".")
+28 IF FBCATC=2
WRITE "Cost recover from LTC co-pay"_$SELECT(FBINS:" and insurance.",1:".")
+29 IF FBCATC=3
WRITE $SELECT(FBINS:"Cost recover from insurance, ",1:"")_"1010EC Missing for LTC Patient."
+30 IF FBCATC=4
WRITE $SELECT(FBINS:"Cost Recover from insurance and ",1:"")_"Potential Cost Recover from LTC co-pay."
End DoDot:1
+31 ;
+32 QUIT
HDR ;main header
+1 DO HDR^FBPCR
if FBOUT
QUIT
HDR1 ;FB*3.5*163 - Changed from FEE to NVC
WRITE !!?(IOM-(13+$LENGTH(FBXPROG))/2),"NVC PROGRAM: ",FBXPROG
+1 WRITE !?1,"Invoice Date",?15,"Invoice No.",?31,"From Date",?48,"To Date",?57,"Patient Control #"
+2 ; W !?1,"Amt Claimed",?15,"Amt Paid",?25,"Cov Days",?36,"Adj Codes",?49,"Adj Amounts",?63,"Remit Remarks",!,FBDASH
+3 ; FB*3.5*163
WRITE !?1,"Amt Claimed",?15,"Amt Paid",?25,"Cov Days",?36,"Adj Codes",?49,"Adj Amounts",?63,"Remit Remarks"
+4 ;FB*3.5*163
WRITE !?1,"Billed?",?9,"Bill#",?24,"Ins Auth#",!,FBDASH
+5 QUIT
SH ;subheader - vendor, prints when name changed
+1 IF ($Y+7)>IOSL
DO HDR
if FBOUT
QUIT
+2 WRITE !!,"Vendor: ",$PIECE(FBVI,";"),?41,"Vendor ID: ",$PIECE($PIECE(FBVI,";",2),"/",1)
+3 WRITE !?20,"Fee Basis Billing Provider NPI: ",$PIECE(FBVI,"/",2)
+4 QUIT
SHA ;ancillary subheader
+1 IF ($Y+16)>IOSL
DO PAGE
if FBOUT
QUIT
+2 WRITE !?20,">>> ANCILLARY SERVICE PAYMENTS <<<",!
SHA1 ;subheader for ancillary data
+1 WRITE !!,?1,"Svc Date",?11,"CPT-MOD ",?19,"Travel Paid",?31,"Units Paid",?43,"Batch No.",?54,"Inv No.",?64,"Voucher Date"
+2 WRITE !,"Amt Claimed",?13,"Amt Paid",?23,"Adj Code",?36,"Adj Amounts",?48,"Remit Remark",?61,"Patient Account No",!,FBDASH
+3 QUIT
SHA2 ;subheader for vendor name
+1 IF ($Y+9)>IOSL
DO HDR
if FBOUT
QUIT
DO SH
DO SHA
+2 IF FBOV'=FBV
SET FBOV=FBV
+3 WRITE !!,"Vendor: ",$PIECE(FBV,";"),?41,"Vendor ID/NPI: ",$PIECE(FBV,";",2)
+4 QUIT
CR ;read for display
+1 if 'FBPG
QUIT
SET DIR(0)="E"
WRITE !
DO ^DIR
KILL DIR
if $DATA(DUOUT)!($DATA(DTOUT))
SET FBOUT=1
+2 QUIT
PAGE ;new page
+1 DO HDR
if FBOUT
QUIT
DO SH
+2 QUIT
WRTDX ;input
+1 ; FBDATA contains node from ^TMP
+2 ; I contains piece to be written
+3 IF I=1!($X+$LENGTH($PIECE(FBDATA,"^",I))+1>IOM)
WRITE !,?4,"DX/POA: "
+4 WRITE $PIECE(FBDATA,"^",I)," "
+5 QUIT
WRTPC ;input
+1 ;FBDATA contains node from ^TMP
+2 ;I contains piece to be written
+3 ; if FBNEWLN true then force new line and label for procedure
+4 NEW FBRPROV
+5 SET FBRPROV=$GET(^TMP($JOB,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,FBI,"RPROV",I))
+6 ; start new line for procedures when appropriate
+7 IF FBRPROV'=""
SET FBNEWLN=1
+8 IF FBNEWLN!($X+$LENGTH($PIECE(FBDATA,"^",I))+2>IOM)
WRITE !?4,"PROC: "
SET FBNEWLN=0
+9 ; write procedure code
+10 WRITE $PIECE(FBDATA,"^",I)," "
+11 ; write line rendering provider data if applicable
+12 IF FBRPROV=""
QUIT
+13 WRITE ?20,"RENDERING PROVIDER NAME: "_$PIECE(FBRPROV,U,2)
+14 WRITE !?21,"NPI: "_$PIECE(FBRPROV,U,3)
+15 WRITE ?46,"TAXONOMY CODE: "_$PIECE(FBRPROV,U,4)
+16 ; force new line for next procedure
SET FBNEWLN=1
+17 QUIT
+18 ;I I=1!($X+$L($P(FBDATA,"^",I))+1>IOM) W !,?4,"PROC: "
+19 ;W $P(FBDATA,"^",I)," "
+20 ;Q
+21 ;S FBRPROV=$G(^TMP($J,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,FBI,"RPROV",I)) ; FB*3.5*122
+22 ;W !,?2,"PROC: ",$P(FBDATA,U,I) I FBRPROV="" Q ; FB*3.5*122
+23 ;W ?20,"RENDERING PROVIDER NAME: "_$P(FBRPROV,U,2),!,?21,"NPI: "_$P(FBRPROV,U,3),?46,"TAXONOMY CODE: "_$P(FBRPROV,U,4) S FBRPROV=1 ; FB*3.5*122
+24 ;Q
WRTSC ;write service connected
+1 WRITE !,"SERVICE CONNECTED? ",$SELECT(+VAEL(3):"YES",1:"NO"),!
+2 QUIT
+3 ;
