VistA-WorldVistAEHR/r/ACCOUNTS_RECEIVABLE-PRCA-PR.../RCDPRTP0.m

66 lines
2.7 KiB
Mathematica

RCDPRTP0 ;ALB/LDB - CLAIMS MATCHING REPORT ;5/24/00 10:48 AM
;;4.5;Accounts Receivable;**151**;Mar 20, 1995
;
;
PAT ;find patient bills
S RCNAM=$$NAM^RCFN01(RCDEBT)
S RCSSN=$$SSN^RCFN01(RCDEBT)
S RCBIL=0 F S RCBIL=$O(^PRCA(430,"E",RCDFN,RCBIL)) Q:'RCBIL D
.I $P($G(^PRCA(430,+RCBIL,0)),"^",2)'=9 Q
.S RCPAY=0 F S RCPAY=$O(^PRCA(433,"C",RCBIL,RCPAY)) Q:'RCPAY D
..S RCPAY1=$G(^PRCA(433,+RCPAY,1)) Q:RCPAY1=""
..I "^2^34^"[("^"_$P(RCPAY1,"^",2)_"^"),($P(RCPAY1,"^",9)'<DATESTRT),($P(RCPAY1,"^",9)<(DATEEND_".999999")) D
...S DFN=RCDFN D DEM^VADPT,ELIG^VADPT
...S ^TMP("RCDPRTPB",$J,RCNAM)=$P($G(VADM(3)),"^",2)_"^"_$P($G(VAEL(1)),"^",2)_"^"_RCSSN
...S ^TMP("RCDPRTPB",$J,RCNAM,RCBIL)=$P($P(RCPAY1,"^",9),".")
...K DFN,VA,VADM,VAEL,VAERR
K RCDFN,RCDEBT
Q
;
DATE ;find third party bills by date of payments
N RCDFN,RCDEBT
F RCTYP=2,34 S DAT=(DATESTRT-1)_".999999" F S DAT=$O(^PRCA(433,"AT",RCTYP,DAT)) Q:'DAT!(DAT>(DATEEND_".999999")) D
.S RCPAY=0 F S RCPAY=$O(^PRCA(433,"AT",RCTYP,DAT,RCPAY)) Q:'RCPAY D
..S RCBIL=$P($G(^PRCA(433,+RCPAY,0)),"^",2)
..S RCBIL0=$G(^PRCA(430,+RCBIL,0)) Q:RCBIL0=""
..Q:$P(RCBIL0,"^",2)'=9
..S RCDFN=$P(RCBIL0,"^",7)
..S RCDEBT=$O(^RCD(340,"B",RCDFN_";DPT(",0)) Q:'RCDEBT
..S RCNAM=$$NAM^RCFN01(RCDEBT)
..S RCSSN=$$SSN^RCFN01(RCDEBT)
..S DFN=RCDFN D DEM^VADPT,ELIG^VADPT
..S ^TMP("RCDPRTPB",$J,RCNAM_"^"_RCDEBT)=$P($G(VADM(3)),"^",2)_"^"_$P($G(VAEL(1)),"^",2)_"^"_RCSSN
..S ^TMP("RCDPRTPB",$J,RCNAM_"^"_RCDEBT,RCBIL)=$P(DAT,".")
..K DFN,VA,VADM,VAEL,VAERR
Q
;
BILL ;set TMP array
S RCNAM=$$NAM^RCFN01(RCDEBT)
S RCSSN=$$SSN^RCFN01(RCDEBT)
S DFN=+$G(^RCD(340,RCDEBT,0))
D DEM^VADPT,ELIG^VADPT
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),".")
S ^TMP("RCDPRTPB",$J,RCNAM)=$P($G(VADM(3)),"^",2)_"^"_$P($G(VAEL(1)),"^",2)_"^"_RCSSN
S ^TMP("RCDPRTPB",$J,RCNAM,RCBILL)=RCTP
K DFN,VA,VADM,VAEL,VAERR,RCBILL,RCTP
Q
;
REC ;find receipt payments
N RCDEBT,RCDFN
S RCREC1=0 F S RCREC1=$O(^PRCA(433,"AF",RCPT,RCREC1)) Q:'RCREC1 D
.S RCPAY1=$G(^PRCA(433,+RCREC1,1)) Q:RCPAY1=""
.S RCBIL=0 I "^2^34^"[("^"_$P(RCPAY1,"^",2)_"^") S RCBIL=$P($G(^PRCA(433,+RCREC1,0)),"^",2)
.Q:'RCBIL
.S RCBIL0=$G(^PRCA(430,+RCBIL,0))
.Q:$P(RCBIL0,"^",2)'=9
.S RCDFN=$P(RCBIL0,"^",7) Q:'RCDFN
.S RCDEBT=$O(^RCD(340,"B",RCDFN_";DPT(",0)) Q:'RCDEBT
.S RCSSN=$$SSN^RCFN01(RCDEBT)
.S RCNAM=$$NAM^RCFN01(RCDEBT)
.S DFN=RCDFN D DEM^VADPT,ELIG^VADPT
.S ^TMP("RCDPRTPB",$J,RCNAM_"^"_RCDEBT)=$P($G(VADM(3)),"^",2)_"^"_$P($G(VAEL(1)),"^",2)_"^"_RCSSN
.K DFN,VA,VADM,VAEL,VAERR
.S ^TMP("RCDPRTPB",$J,RCNAM_"^"_RCDEBT,RCBIL)=$P($P($G(^PRCA(433,+RCREC1,1)),"^",9),".")
Q
;