source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPRTP0.m@ 1800

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

initial load of FOIAVistA 6/30/08 version

File size: 2.7 KB
Line 
1RCDPRTP0 ;ALB/LDB - CLAIMS MATCHING REPORT ;5/24/00 10:48 AM
2 ;;4.5;Accounts Receivable;**151**;Mar 20, 1995
3 ;
4 ;
5PAT ;find patient bills
6 S RCNAM=$$NAM^RCFN01(RCDEBT)
7 S RCSSN=$$SSN^RCFN01(RCDEBT)
8 S RCBIL=0 F S RCBIL=$O(^PRCA(430,"E",RCDFN,RCBIL)) Q:'RCBIL D
9 .I $P($G(^PRCA(430,+RCBIL,0)),"^",2)'=9 Q
10 .S RCPAY=0 F S RCPAY=$O(^PRCA(433,"C",RCBIL,RCPAY)) Q:'RCPAY D
11 ..S RCPAY1=$G(^PRCA(433,+RCPAY,1)) Q:RCPAY1=""
12 ..I "^2^34^"[("^"_$P(RCPAY1,"^",2)_"^"),($P(RCPAY1,"^",9)'<DATESTRT),($P(RCPAY1,"^",9)<(DATEEND_".999999")) D
13 ...S DFN=RCDFN D DEM^VADPT,ELIG^VADPT
14 ...S ^TMP("RCDPRTPB",$J,RCNAM)=$P($G(VADM(3)),"^",2)_"^"_$P($G(VAEL(1)),"^",2)_"^"_RCSSN
15 ...S ^TMP("RCDPRTPB",$J,RCNAM,RCBIL)=$P($P(RCPAY1,"^",9),".")
16 ...K DFN,VA,VADM,VAEL,VAERR
17 K RCDFN,RCDEBT
18 Q
19 ;
20DATE ;find third party bills by date of payments
21 N RCDFN,RCDEBT
22 F RCTYP=2,34 S DAT=(DATESTRT-1)_".999999" F S DAT=$O(^PRCA(433,"AT",RCTYP,DAT)) Q:'DAT!(DAT>(DATEEND_".999999")) D
23 .S RCPAY=0 F S RCPAY=$O(^PRCA(433,"AT",RCTYP,DAT,RCPAY)) Q:'RCPAY D
24 ..S RCBIL=$P($G(^PRCA(433,+RCPAY,0)),"^",2)
25 ..S RCBIL0=$G(^PRCA(430,+RCBIL,0)) Q:RCBIL0=""
26 ..Q:$P(RCBIL0,"^",2)'=9
27 ..S RCDFN=$P(RCBIL0,"^",7)
28 ..S RCDEBT=$O(^RCD(340,"B",RCDFN_";DPT(",0)) Q:'RCDEBT
29 ..S RCNAM=$$NAM^RCFN01(RCDEBT)
30 ..S RCSSN=$$SSN^RCFN01(RCDEBT)
31 ..S DFN=RCDFN D DEM^VADPT,ELIG^VADPT
32 ..S ^TMP("RCDPRTPB",$J,RCNAM_"^"_RCDEBT)=$P($G(VADM(3)),"^",2)_"^"_$P($G(VAEL(1)),"^",2)_"^"_RCSSN
33 ..S ^TMP("RCDPRTPB",$J,RCNAM_"^"_RCDEBT,RCBIL)=$P(DAT,".")
34 ..K DFN,VA,VADM,VAEL,VAERR
35 Q
36 ;
37BILL ;set TMP array
38 S RCNAM=$$NAM^RCFN01(RCDEBT)
39 S RCSSN=$$SSN^RCFN01(RCDEBT)
40 S DFN=+$G(^RCD(340,RCDEBT,0))
41 D DEM^VADPT,ELIG^VADPT
42 S RCTP=0 F S RCTP=$O(^PRCA(433,"C",RCBILL,RCTP)) Q:'RCTP I "^2^34^"[("^"_$P($G(^PRCA(433,+RCTP,1)),"^",2)_"^") S RCTP(0)=$P($P($G(^PRCA(433,+RCTP,1)),"^",9),".")
43 S ^TMP("RCDPRTPB",$J,RCNAM)=$P($G(VADM(3)),"^",2)_"^"_$P($G(VAEL(1)),"^",2)_"^"_RCSSN
44 S ^TMP("RCDPRTPB",$J,RCNAM,RCBILL)=RCTP
45 K DFN,VA,VADM,VAEL,VAERR,RCBILL,RCTP
46 Q
47 ;
48REC ;find receipt payments
49 N RCDEBT,RCDFN
50 S RCREC1=0 F S RCREC1=$O(^PRCA(433,"AF",RCPT,RCREC1)) Q:'RCREC1 D
51 .S RCPAY1=$G(^PRCA(433,+RCREC1,1)) Q:RCPAY1=""
52 .S RCBIL=0 I "^2^34^"[("^"_$P(RCPAY1,"^",2)_"^") S RCBIL=$P($G(^PRCA(433,+RCREC1,0)),"^",2)
53 .Q:'RCBIL
54 .S RCBIL0=$G(^PRCA(430,+RCBIL,0))
55 .Q:$P(RCBIL0,"^",2)'=9
56 .S RCDFN=$P(RCBIL0,"^",7) Q:'RCDFN
57 .S RCDEBT=$O(^RCD(340,"B",RCDFN_";DPT(",0)) Q:'RCDEBT
58 .S RCSSN=$$SSN^RCFN01(RCDEBT)
59 .S RCNAM=$$NAM^RCFN01(RCDEBT)
60 .S DFN=RCDFN D DEM^VADPT,ELIG^VADPT
61 .S ^TMP("RCDPRTPB",$J,RCNAM_"^"_RCDEBT)=$P($G(VADM(3)),"^",2)_"^"_$P($G(VAEL(1)),"^",2)_"^"_RCSSN
62 .K DFN,VA,VADM,VAEL,VAERR
63 .S ^TMP("RCDPRTPB",$J,RCNAM_"^"_RCDEBT,RCBIL)=$P($P($G(^PRCA(433,+RCREC1,1)),"^",9),".")
64 Q
65 ;
Note: See TracBrowser for help on using the repository browser.