source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPRTP1.m@ 794

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

initial load of FOIAVistA 6/30/08 version
File size: 5.3 KB
Line 
1RCDPRTP1 ;ALB/LDB - CLAIMS MATCHING REPORT (PRINT) ;1/26/01 2:56 PM
2 ;;4.5;Accounts Receivable;**151,169**;Mar 20, 1995
3 ;
4 ;
5EN ; Entry point to print the Claims Matching Report.
6 N %,DATEDIS1,DATEDIS2,NOW,PG,RCBILL,RCAMT,RCAMT1,RCIBDAT,RCIBFN,RCNAM,RCNAM1,RCNO,RCNOW,RCDLINE,RCLINE,RCPHIT,RCQ,RCSSN,RCSTAT,RCTP,X,Y
7 ;
8 ; - initialize report header variables
9 S PG=0
10 I RCSORT'=2,(RCSORT'=4) D
11 .S Y=$P(DATESTRT,".") D DD^%DT S DATEDIS1=Y
12 .S Y=$P(DATEEND,".") D DD^%DT S DATEDIS2=Y
13 D NOW^%DTC S Y=% D DD^%DT S RCNOW=$E(Y,1,18)
14 S RCDLINE=$TR($J("",80)," ","-")
15 S RCLINE=$TR($J("",80)," ","*")
16 ;
17 ; - main report loop
18 K ^TMP($J)
19 ;
20 ;
21 D HDR ; initial header
22 S RCNO=0 ; flag to indicate at least one matching claim
23 ;
24 S RCNAM="" F S RCNAM=$O(^TMP("RCDPRTPB",$J,RCNAM)) Q:RCNAM=""!$G(RCQ) D
25 .S RCBILL=0 F S RCBILL=$O(^TMP("RCDPRTPB",$J,RCNAM,RCBILL)) Q:'RCBILL!$G(RCQ) D
26 ..;
27 ..S RCPHIT=0 ; flag that requires patient info to print
28 ..D PROC ; process a single third party bill
29 ..K ^TMP("IBRBT",$J),^TMP("IBRBF",$J)
30 ;
31 I $G(RCQ) G ENQ
32 ;
33 I $O(^TMP("RCDPRTPB",$J,0))="" W !!,?18,"No matching debts." Q
34 I 'RCNO W !!,?18,"No matching debts."
35ENQ ;
36 Q
37 ;
38 ;
39PROC ; Process each third party bill for a patient.
40 D RELBILL^IBRFN(RCBILL)
41 ;
42 ; - quit if there are no associated first party bills
43 I '$O(^TMP("IBRBF",$J,0)) K ^TMP("RCDPRTPB",$J,RCNAM,RCBILL) G PROCQ
44 ;
45 S (RCAMT(0),RCAMT(1))=0
46 ;
47 S RCTP(0)=0 F S RCTP(0)=$O(^TMP("IBRBF",$J,RCTP(0))) Q:'RCTP(0) S RCTP(1)=0 F S RCTP(1)=$O(^TMP("IBRBF",$J,RCTP(0),RCTP(1))) Q:'RCTP(1) S ^TMP($J,"IBRBF",RCTP(1),RCTP(0))=""
48 S RCPT(0)=0 F S RCTP(0)=$O(^TMP($J,"IBRBF",RCTP(0))) Q:'RCTP(0) S RCTP(1)=0 F S RCTP(1)=$O(^TMP($J,"IBRBF",RCTP(0),RCTP(1))) Q:'RCTP(1) D
49 .I RCTP(1)=RCBILL Q
50 .I $D(^TMP($J,"IBRBF",RCTP(0),RCBILL))!(RCTP(1)'=$O(^TMP($J,"IBRBF",RCTP(0),0))) K ^TMP("IBRBF",$J,RCTP(1),RCTP(0)),^TMP($J,"IBRBF",RCTP(0),RCTP(1)) I '$O(^TMP("IBRBF",$J,RCTP(1),0)) K ^TMP("IBRBF",$J,RCTP(1))
51 S RCTP(0)="" F S RCTP(0)=$O(^TMP("IBRBT",$J,RCBILL,RCTP(0))) Q:RCTP(0)="" D
52 .;if associated third party has had payment also do not list twice
53 .I $D(^TMP("RCDPRTPB",$J,RCNAM,RCTP(0))),(RCBILL'=RCTP(0)) S RCTP(RCTP(0))=^TMP("RCDPRTPB",$J,RCNAM,RCTP(0)) K ^(RCTP(0))
54 .;if no prescription coverage exclude associated rx co-pay charges
55 .I '$P(^TMP("IBRBT",$J,RCBILL),"^") D
56 ..S RCTP(1)=0 F S RCTP(1)=$O(^TMP("IBRBF",$J,RCTP(0),RCTP(1))) Q:RCTP(1)="" I $G(^TMP("IBRBF",$J,RCTP(0),RCTP(1)))["RX" K ^TMP("IBRBF",$J,RCTP(0),RCTP(1)) I '$O(^TMP("IBRBF",$J,RCTP(0),"")) K ^TMP("IBRBF",$J,RCTP(0))
57 .;if duplicate charges exclude them from report
58 S RCTP(0)=0 F S RCTP(0)=$O(^TMP("IBRBF",$J,RCTP(0))) Q:RCTP(0)="" S RCTP(1)=0 F S RCTP(1)=$O(^TMP("IBRBF",$J,RCTP(0),RCTP(1))) Q:'RCTP(1) D
59 .I RCTP(0)'=RCBILL,($D(^TMP("IBRBF",$J,RCBILL,RCTP(1)))) K ^TMP("IBRBF",$J,RCTP(0),RCTP(1)) K:'$O(^TMP("IBRBF",$J,RCTP(0),0)) ^TMP("IBRBF",$J,RCTP(0))
60 ;exclude cancelled charges if not selected to be on report
61 I 'RCAN D
62 .S RCTP(0)=0 F S RCTP(0)=$O(^TMP("IBRBF",$J,RCTP(0))) Q:RCTP(0)="" S RCTP(1)=0 F S RCTP(1)=$O(^TMP("IBRBF",$J,RCTP(0),RCTP(1))) Q:'RCTP(1) D
63 ..I $P(^TMP("IBRBF",$J,RCTP(0),RCTP(1)),"^",3) K ^TMP("IBRBF",$J,RCTP(0),RCTP(1)) Q
64 ..S RCPT(2)=$O(^PRCA(430,"B",+$P(^TMP("IBRBF",$J,RCTP(0),RCTP(1)),"^",4),0)) I $P($G(^PRCA(430,+RCPT(2),0)),"^",8)=39 K ^TMP("IBRBF",$J,RCTP(0),RCTP(1))
65 ..I '$O(^TMP("IBRBF",$J,RCTP(0),"")) K ^TMP("IBRBF",$J,RCTP(0))
66 I '$O(^TMP("IBRBF",$J,RCBILL,0)) K ^TMP("RCDPRTPB",$J,RCNAM,RCBILL) G PROCQ
67 ;
68 ; - print patient detail line
69 I 'RCPHIT S RCPHIT=1 D PRINT3^RCDPRTP2 G:$G(RCQ) PROCQ
70 ;
71 ; - print third party bills
72 ; o print the header first; need room for the header and
73 ; the bill that was paid.
74 ; o print the bill that was paid.
75 S RCTP=RCBILL,RCIBDAT=$G(^TMP("IBRBT",$J,RCBILL,RCBILL))
76 I $Y>(IOSL-7) D PAUSE^RCDPRTP2 G:$G(RCQ) PROCQ D HDR
77 D HDR1^RCDPRTP2,PRINT1^RCDPRTP2 G:$G(RCQ) PROCQ
78 ;
79 ; - print the other assoicated third party bills
80 S RCTP=0 F S RCTP=$O(^TMP("IBRBT",$J,RCBILL,RCTP)) Q:'RCTP!$G(RCQ) D
81 .I RCBILL=RCTP Q ; don't reprint the bill that was paid.
82 .S RCIBDAT=$G(^TMP("IBRBT",$J,RCBILL,RCTP))
83 .I 'RCAN,($P(RCIBDAT,"^",3)) Q ; exclude cancelled claims
84 .D PRINT1^RCDPRTP2
85 G:$G(RCQ) PROCQ
86 ;
87 ; - print the third party totals
88 I $Y>(IOSL-2) D PAUSE^RCDPRTP2 G:$G(RCQ) PROCQ D HDR W !
89 W !,?57,"---------",?68,"---------"
90 W !,?57,$J(RCAMT(0),9,2),?68,$J(RCAMT(1),9,2)
91 ;
92 ; - print the associated first party charges
93 S RCTP(0)=0 F S RCTP(0)=$O(^TMP("IBRBF",$J,RCTP(0))) Q:'RCTP(0)!$G(RCQ) D
94 .I RCTP(0)=$O(^TMP("IBRBF",$J,0)) D
95 ..I $Y>(IOSL-5) D PAUSE^RCDPRTP2 Q:$G(RCQ) D HDR
96 ..D HDR2^RCDPRTP2
97 .S RCTP=0 F S RCTP=$O(^TMP("IBRBF",$J,RCTP(0),RCTP)) Q:'RCTP!$G(RCQ) D
98 ..S RCNO=1 ; set flag for at least one match
99 ..;
100 ..S RCIBDAT=$G(^TMP("IBRBF",$J,RCTP(0),RCTP))
101 ..;
102 ..; - print the header for the first charge
103 ..;
104 ..; - print the patient detail line
105 ..D PRINT2^RCDPRTP2
106 ;.
107PROCQ K ^TMP($J) Q
108 ;
109 ;
110HDR ; Print the main report header.
111 S PG=PG+1 I PG'=1!($E(IOST,1,2)="C-") W @IOF
112 W !,?5,"THIRD PARTY CLAIMS W/MATCHING FIRST PARTY DEBTS ",RCNOW," PAGE ",PG
113 I RCSORT'=2,(RCSORT'=4) W !,?18,"FOR THE PAYMENT DATES: ",DATEDIS1," TO ",DATEDIS2
114 I RCSORT=4 W !,?18,"RECEIPT NUMBER ",RCPT
115 W !,RCDLINE
116 I PG=1 D
117 .W !!,"Remember that any actions taken to decrease the first party receivables must"
118 .W !,"consider any applicable deductibles or coinsurance amounts specified on the EOB."
119 Q
120 ;
Note: See TracBrowser for help on using the repository browser.