1 | FBPCR671 ;AISC/DMK,TET-CH/CNH POTENTIAL COST RECOVERY PRINT ;07/18/2006
|
---|
2 | ;;3.5;FEE BASIS;**4,48,55,69,76,98**;JAN 30, 1995;Build 54
|
---|
3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | PRINT ;print data from tmp global
|
---|
5 | I FBPG>1&(($Y+12)>IOSL) D HDR Q:FBOUT
|
---|
6 | E D HDR1
|
---|
7 | S FBVI="" F S FBVI=$O(^TMP($J,"FB",FBPSF,FBPT,FBPI,FBVI)) Q:FBVI']""!(FBOUT) D SH Q:FBOUT D Q:FBOUT
|
---|
8 | .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
|
---|
9 | ..I ($Y+5)>IOSL D PAGE Q:FBOUT
|
---|
10 | ..S FBDATA=^TMP($J,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,FBI),FBCATC=$P(FBDATA,U,9),FBINS=$P(FBDATA,U,10)
|
---|
11 | ..S FBINV=^TMP($J,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,FBI,"FBINV")
|
---|
12 | ..W ! W:$P(FBDATA,U,8)["R" "*" W:$P(FBDATA,U,9)]"" "#"
|
---|
13 | ..W ?2,$P(FBDATA,U,1),?15,$P(FBDATA,U,5),?31,$P(FBDATA,U,6)
|
---|
14 | ..W ?47,$P(FBDATA,U,7),?57,$P(FBINV,U,2)
|
---|
15 | ..W !?2,$P(FBDATA,U,2),?15,$P(FBDATA,U,3),?25,$P(FBINV,U,1)
|
---|
16 | .. ;Print adj reasons, if null then print suspend code
|
---|
17 | ..W ?36,$S($P(FBINV,U,3)]"":$P(FBINV,U,3),1:$P(FBDATA,U,4))
|
---|
18 | ..W ?46,$S($P(FBINV,U,3)]"":$J($P(FBINV,U,4),14),1:$J($P(FBDATA,U,10),14))
|
---|
19 | ..W ?63,$P(FBINV,U,5)
|
---|
20 | ..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)," "
|
---|
21 | ..I FBCATC!FBINS D
|
---|
22 | ...W !?5,">>>"
|
---|
23 | ...I FBCATC=0 W "Cost recover from insurance."
|
---|
24 | ...I FBCATC=1 W "Cost recover from means testing"_$S(FBINS:" and insurance.",1:".")
|
---|
25 | ...I FBCATC=2 W "Cost recover from LTC co-pay"_$S(FBINS:" and insurance.",1:".")
|
---|
26 | ...I FBCATC=3 W $S(FBINS:"Cost recover from insurance, ",1:"")_"1010EC Missing for LTC Patient."
|
---|
27 | ...I FBCATC=4 W $S(FBINS:"Cost Recover from insurance and ",1:"")_"Potential Cost Recover from LTC co-pay."
|
---|
28 | ..;
|
---|
29 | ..I +$O(^TMP($J,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,FBI,"A",0)) D Q:FBOUT W !,FBDASH1
|
---|
30 | ...S (FBOV,FBCNT)=0,FBSL=7 D SHA Q:FBOUT
|
---|
31 | ...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
|
---|
32 | ....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:"**********")
|
---|
33 | Q
|
---|
34 | WRT ;write ancillary info
|
---|
35 | N FBCATC,FBINS,FBADJ I ($Y+4)>IOSL D PAGE Q:FBOUT D SHA,SHA2
|
---|
36 | D:FBOV'=FBV SHA2
|
---|
37 | S FBADJ=^TMP($J,"FB",FBPSF,FBPT,FBPI,FBVI,FBDT,FBI,"A",FBCNT,"FBADJ")
|
---|
38 | S FBCATC=$P(FBDATA,U,14),FBINS=$P(FBDATA,U,15)
|
---|
39 | W !
|
---|
40 | W ?1,$P(FBDATA,U,1)
|
---|
41 | W ?11,$P($P(FBDATA,U,2),",")
|
---|
42 | W ?31,$J($P(FBADJ,U,2),10)
|
---|
43 | W ?43,$P(FBDATA,U,6)
|
---|
44 | W ?54,$P(FBDATA,U,7)
|
---|
45 | W ?64,$P(FBDATA,U,8)
|
---|
46 | I $P($P(FBDATA,U,2),",",2)]"" D Q:FBOUT
|
---|
47 | . N FBI,FBMOD
|
---|
48 | . F FBI=2:1 S FBMOD=$P($P(FBDATA,U,2),",",FBI) Q:FBMOD="" D Q:FBOUT
|
---|
49 | . . I $Y+6>IOSL D PAGE Q:FBOUT D SHA,SHA2 W !," (continued)"
|
---|
50 | . . W !,?16,"-",FBMOD
|
---|
51 | W !,$P(FBDATA,U,3)
|
---|
52 | W ?13,$P(FBDATA,U,4)
|
---|
53 | W ?23,$S($P(FBADJ,U,3)]"":$P(FBADJ,U,3),1:$P(FBDATA,U,5))
|
---|
54 | W ?33,$J($S($P(FBADJ,U,4)]"":$J($P(FBADJ,U,4),14),1:$P(FBADJ,U,1)),14)
|
---|
55 | W ?48,$P(FBADJ,U,5)
|
---|
56 | W ?60,$P(FBADJ,U,6)
|
---|
57 | W !?5,"Primary Dx: ",$P(FBDATA,U,9),?40,"S/C Condition? ",$P(FBDATA,U,8),?66,"Obl.#: ",$P(FBDATA,U,10)
|
---|
58 | I FBCATC!FBINS D
|
---|
59 | .W !?5,">>>"
|
---|
60 | .I FBCATC=0 W "Cost recover from insurance."
|
---|
61 | .I FBCATC=1 W "Cost recover from means testing"_$S(FBINS:" and insurance.",1:".")
|
---|
62 | .I FBCATC=2 W "Cost recover from LTC co-pay"_$S(FBINS:" and insurance.",1:".")
|
---|
63 | .I FBCATC=3 W $S(FBINS:"Cost recover from insurance, ",1:"")_"1010EC Missing for LTC Patient."
|
---|
64 | .I FBCATC=4 W $S(FBINS:"Cost Recover from insurance and ",1:"")_"Potential Cost Recover from LTC co-pay."
|
---|
65 | ;
|
---|
66 | Q
|
---|
67 | HDR ;main header
|
---|
68 | D HDR^FBPCR Q:FBOUT
|
---|
69 | HDR1 W !!?(IOM-(13+$L(FBXPROG))/2),"FEE PROGRAM: ",FBXPROG
|
---|
70 | W !?1,"Invoice Date",?15,"Invoice No.",?31,"From Date",?48,"To Date",?57,"Patient Control #"
|
---|
71 | W !?1,"Amt Claimed",?15,"Amt Paid",?25,"Cov Days",?36,"Adj Codes",?49,"Adj Amounts",?63,"Remit Remarks",!,FBDASH
|
---|
72 | Q
|
---|
73 | SH ;subheader - vendor, prints when name changed
|
---|
74 | I ($Y+7)>IOSL D HDR Q:FBOUT
|
---|
75 | W !!,"Vendor: ",$P(FBVI,";"),?41,"Vendor ID: ",$P($P(FBVI,";",2),"/",1)
|
---|
76 | W !?20,"Fee Basis Billing Provider NPI: ",$P(FBVI,"/",2)
|
---|
77 | Q
|
---|
78 | SHA ;ancillary subheader
|
---|
79 | I ($Y+16)>IOSL D PAGE Q:FBOUT
|
---|
80 | W !?20,">>> ANCILLARY SERVICE PAYMENTS <<<",!
|
---|
81 | SHA1 ;subheader for ancillary data
|
---|
82 | W !!,?1,"Svc Date",?11,"CPT-MOD ",?19,"Travel Paid",?31,"Units Paid",?43,"Batch No.",?54,"Inv No.",?64,"Voucher Date"
|
---|
83 | W !,"Amt Claimed",?13,"Amt Paid",?23,"Adj Code",?36,"Adj Amounts",?48,"Remit Remark",?61,"Patient Account No",!,FBDASH
|
---|
84 | Q
|
---|
85 | SHA2 ;subheader for vendor name
|
---|
86 | I ($Y+9)>IOSL D HDR Q:FBOUT D SH,SHA
|
---|
87 | I FBOV'=FBV S FBOV=FBV
|
---|
88 | W !!,"Vendor: ",$P(FBV,";"),?41,"Vendor ID/NPI: ",$P(FBV,";",2)
|
---|
89 | Q
|
---|
90 | CR ;read for display
|
---|
91 | Q:'FBPG S DIR(0)="E" W ! D ^DIR K DIR S:$D(DUOUT)!($D(DTOUT)) FBOUT=1
|
---|
92 | Q
|
---|
93 | PAGE ;new page
|
---|
94 | D HDR Q:FBOUT D SH
|
---|
95 | Q
|
---|
96 | WRTDX I $P(FBDX,"^",K)]"" W ?4,"Dx: ",$$ICD9^FBCSV1($P(FBDX,"^",K))," " Q
|
---|
97 | Q
|
---|
98 | WRTPC I $P(FBPROC,"^",L)]"" W ?4,"Proc: ",$$ICD0^FBCSV1($P(FBPROC,"^",L))," " Q
|
---|
99 | Q
|
---|
100 | WRTSC ;write service connected
|
---|
101 | W !,"SERVICE CONNECTED? ",$S(+VAEL(3):"YES",1:"NO"),!
|
---|
102 | Q
|
---|