source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBPCR671.m@ 1226

Last change on this file since 1226 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 5.0 KB
Line 
1FBPCR671 ;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.
4PRINT ;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
34WRT ;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
67HDR ;main header
68 D HDR^FBPCR Q:FBOUT
69HDR1 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
73SH ;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
78SHA ;ancillary subheader
79 I ($Y+16)>IOSL D PAGE Q:FBOUT
80 W !?20,">>> ANCILLARY SERVICE PAYMENTS <<<",!
81SHA1 ;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
85SHA2 ;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
90CR ;read for display
91 Q:'FBPG S DIR(0)="E" W ! D ^DIR K DIR S:$D(DUOUT)!($D(DTOUT)) FBOUT=1
92 Q
93PAGE ;new page
94 D HDR Q:FBOUT D SH
95 Q
96WRTDX I $P(FBDX,"^",K)]"" W ?4,"Dx: ",$$ICD9^FBCSV1($P(FBDX,"^",K))," " Q
97 Q
98WRTPC I $P(FBPROC,"^",L)]"" W ?4,"Proc: ",$$ICD0^FBCSV1($P(FBPROC,"^",L))," " Q
99 Q
100WRTSC ;write service connected
101 W !,"SERVICE CONNECTED? ",$S(+VAEL(3):"YES",1:"NO"),!
102 Q
Note: See TracBrowser for help on using the repository browser.