RCRJRCOC ;WISC/RFJ/BGJ-count current receivables ; 11/2/10 10:53am
;;4.5;Accounts Receivable;**156,170,182,203,220,138,239,272,273,334,335,338**;Mar 20, 1995;Build 69
;;Per VA Directive 6402, this routine should not be modified.
; IA 4385 for call to $$MRATYPE^IBCEMU2
Q
;
;
CURRENT(RCBILLDA,RCVALUE) ; count current bills balance
; rcvalue = prin ^ int ^ admin ^ mf ^ cc
;
N %,RCFUND,RCRSC,RCTOHSIF,RCTOMCCF,SGL,TYPE,MRATYPE,ARACTDT,CATEGORY,RCRHITYP,RCCATNM
;
; calculate the rsc for the bill. the rsc is only used for
; mccf bills
S RCRSC=""
;PRCA*4.5*338 - Modified the code to only recalculate RSCs if none currently calculated.
S RCRSC=$$GET1^DIQ(430,BILLDA_",",255)
S:RCRSC="" RCRSC=$$GET1^DIQ(430,BILLDA_",",255.1)
I $$ACCK^PRCAACC(RCBILLDA) S:RCRSC="" RCRSC=$$CALCRSC^RCXFMSUR(RCBILLDA)
;
; calculate the amount that goes to mccf and hsif
D MCCFHSIF(RCBILLDA,RCVALUE,RCRSC,DATEEND+1)
;
; store the data for the ndb, if a 0 is returned by the function,
; then the bill has already been counted as a current receivable,quit
I '$$NDBSTORE(RCBILLDA,RCVALUE,1) Q
;
; store results for FMS SV document for accrued bills only
; do not include prepayments (26)
I $$ACCK^PRCAACC(RCBILLDA),$P($G(^PRCA(430,RCBILLDA,0)),"^",2)'=26 D
. ; get the bills fund and category
. ;PRCA*4.5*338 Calculate fund only if it is not stored in the bill
. S RCFUND=$$GET1^DIQ(430,BILLDA_",",203)
. I RCFUND="" S RCFUND=$$GETFUNDB^RCXFMSUF(BILLDA,1)
. ;end PRCA*4.5*338
. S RCFUND=$$ADJFUND^RCRJRCO(RCFUND) ; may remove the line after 10/1/03
. S CATEGORY=+$P($G(^PRCA(430,RCBILLDA,0)),"^",2),RCCATNM=$$GET1^DIQ(430.2,CATEGORY_",",.01) ; retrieve CAT name PRCA*4.5*338
. ;
. ; ----- this code is used to set up the SV code sheet -----
. S TYPE=21
. ; special type for tort feasor
. I RCCATNM["TORT" S TYPE="2A" ;Using the category name to look for TORTs - PRCA*4.5*338
. ;
. ; Get ARACTDT=AR Date Active for bill
. S ARACTDT=+$P($P($G(^PRCA(430,RCBILLDA,6)),"^",21),".")
. ; determine Receivable Type: 1=pre-MRA, 2=post-MRA Medicre, 3=post-MRA non-Medicare
. ; DBIA #4385 activated on 31-Mar-2004
. S MRATYPE=$$MRATYPE^IBCEMU2(RCBILLDA,ARACTDT)
. ; set TYPE to 2F for post-MRA Medicare bills or to 2L for
. ; post-MRA non-Medicare bills (for RHI receivables only)
. ; PRCA*4.5*338 moved TYPE set for RHI to function call to ensure Community Care RSCs are captured correctly.
. S RCRHITYP=$$RHITYPE(RCRSC,MRATYPE,RCCATNM) S:+RCRHITYP TYPE=$P(RCRHITYP,U,2)
. ;
. ; store dollars to mccf and hsif
. I RCTOMCCF S ^TMP($J,"RCRJRCOLSV",TYPE,RCFUND,RCRSC)=$G(^TMP($J,"RCRJRCOLSV",TYPE,RCFUND,RCRSC))+RCTOMCCF
. I RCTOHSIF S ^TMP($J,"RCRJRCOLSV",21,5358.1,$S(RCRSC="8BZZ":"8B1Z",1:"8C1Z"))=$G(^TMP($J,"RCRJRCOLSV",21,5358.1,$S(RCRSC="8BZZ":"8B1Z",1:"8C1Z")))+RCTOHSIF
. ;
. ; ----- this code is used to build the user report
. S %=+$P($P($G(^PRCA(430,RCBILLDA,6)),"^",21),".")
. S ^TMP($J,"RCRJRCOLREPORT",%,RCBILLDA)=$P(RCVALUE,"^")_"^"_($P(RCVALUE,"^",2)+$P(RCVALUE,"^",3)+$P(RCVALUE,"^",4)+$P(RCVALUE,"^",5))_"^SV"_TYPE
. I RCTOMCCF D STORE^RCRJRCOU(BILLDA,DATEBEG,DATEEND,ARACTDT,CATEGORY,"SV"_TYPE,RCFUND,RCRSC,RCVALUE)
. I RCTOHSIF D STORE^RCRJRCOU(BILLDA,DATEBEG,DATEEND,ARACTDT,CATEGORY,"SV21","5358.1",$S(RCRSC="8BZZ":"8B1Z",1:"8C1Z"),RCVALUE)
. ;
. ; ----- this code is used to build the OIG extract, piece 3 = GL acct
. S ^TMP($J,"RCRJROIG",RCBILLDA)=$P(RCVALUE,"^")_"^"_($P(RCVALUE,"^",2)+$P(RCVALUE,"^",3)+$P(RCVALUE,"^",4)+$P(RCVALUE,"^",5))_"^"_$S(TYPE="2A":1333,TYPE="2F":"13H1",TYPE="2L":"13N1",1:1311)
. ;
. ; ----- this code is used to set up medicare supplemental SVs
. S %=$G(^PRCA(430,RCBILLDA,13))
. ; medicare contract adjustment field 131 for bills activated in AR during the month the ARDC is running
. I $P(%,"^",1),ARACTDT'<DATEBEG D ;
. . S ^TMP($J,"RCRJRCOLSV",17)=$G(^TMP($J,"RCRJRCOLSV",17))+$P(%,"^",1)
. . S ^TMP($J,"RCRJRCOLSV",17,RCFUND,RCRSC)=$G(^TMP($J,"RCRJRCOLSV",17,RCFUND,RCRSC))+$P(%,"^",1)
. ; medicare unreimbursable medicare expense field 132 for bills activated in AR during the month the ARDC is running
. I $P(%,"^",2),ARACTDT'<DATEBEG D ;
. . S ^TMP($J,"RCRJRCOLSV",18)=$G(^TMP($J,"RCRJRCOLSV",18))+$P(%,"^",2)
. . S ^TMP($J,"RCRJRCOLSV",18,RCFUND,RCRSC)=$G(^TMP($J,"RCRJRCOLSV",18,RCFUND,RCRSC))+$P(%,"^",2)
. ;
. ; ----- this code is used to set up the bad debt report -----
. S SGL=$$BDRSGL^RCRJRBD(CATEGORY,RCFUND,MRATYPE)
. ; store dollars to mccf and hsif. both are sgl 1319 so 1319.1 is
. ; used to put hsif in a subset of 1319
. I RCTOMCCF S ^TMP($J,"RCRJRBD",SGL)=$G(^TMP($J,"RCRJRBD",SGL))+RCTOMCCF
. I RCTOHSIF S ^TMP($J,"RCRJRBD",1319.1)=$G(^TMP($J,"RCRJRBD",1319.1))+RCTOHSIF
;
; store the interest, admin, mf, cc on the SV code sheet
; interest (type P2; fund 1435; rsc 8047)
I $P(RCVALUE,"^",2) S ^TMP($J,"RCRJRCOLSV","P2",1435,8047)=$G(^TMP($J,"RCRJRCOLSV","P2",1435,8047))+$P(RCVALUE,"^",2)
; admin (type P2; fund 3220; rsc 8046)
I $P(RCVALUE,"^",3) S ^TMP($J,"RCRJRCOLSV","P2",3220,8046)=$G(^TMP($J,"RCRJRCOLSV","P2",3220,8046))+$P(RCVALUE,"^",3)
; mf + cc (type P2; fund 0869; rsc 8048)
S %=$P(RCVALUE,"^",4)+$P(RCVALUE,"^",5)
I % S ^TMP($J,"RCRJRCOLSV","P2","0869",8048)=$G(^TMP($J,"RCRJRCOLSV","P2","0869",8048))+%
Q
;
RHITYPE(RCRSC,MRATYPE,RCCATNM) ;
; Input - RCRSC - Revenue Source Code from a Bill
; RCMRATYP - Type of MRA as determined by the call to $$MRATYPE^IBCEMU2
; Output - Is it a RHI Bill (0 - No, 1 - Yes) ^ SV Type to return (2F or 2L) [required if an RHI Bill]
;
N RCTYPE
S RCTYPE=0
I MRATYPE>1 D
. Q:RCRSC="85CC" ; This specific RSC is a TORT RSC for the CHOICE program
. I $E(RCRSC,1,2)=85!($E(RCRSC,1,2)="8R") S RCTYPE="1^"_$S(MRATYPE=2:"2F",1:"2L") Q
. I RCCATNM["THIRD PARTY" D Q
. . Q:RCCATNM["CHAMPVA" ;Exclude CHAMPVA
. . Q:RCCATNM["TRICARE" ;Exclude TRICARE
. . ;otherwise this is a Community Care Bill, set the SV type
. . S RCTYPE="1^"_$S(MRATYPE=2:"2F",1:"2L")
Q RCTYPE
;
WRITEOFF(RCBILLDA,RCVALUE,RCRITER2) ; count write offs
; rcvalue = prin ^ int ^ admin ^ mf ^ cc
; rcriter2 = write off criteria tracked in ndb
;
N %,RCFUND,RCRSC,RCTOHSIF,RCTOMCCF,TYPE,MRATYPE,ARACTDT
;
; calculate the rsc for the bill. the rsc is only used for
; mccf bills
S RCRSC=""
;PRCA*4.5*338 - Modified the code to only recalculate RSCs if none currently calculated.
S RCRSC=$$GET1^DIQ(430,BILLDA_",",255)
S:RCRSC="" RCRSC=$$GET1^DIQ(430,BILLDA_",",255.1)
I $$ACCK^PRCAACC(RCBILLDA) S:RCRSC="" RCRSC=$$CALCRSC^RCXFMSUR(RCBILLDA)
;
; calculate the amount that goes to mccf and hsif
D MCCFHSIF(RCBILLDA,RCVALUE,RCRSC,DATEEND+1)
;
; store the data for the ndb, if a 0 is returned by the function,
; then the bill has already been counted as a current receivable,quit
I '$$NDBSTORE(RCBILLDA,RCVALUE,RCRITER2) Q
;
; store results for FMS WR document
; do not include prepayments (26)
I $$ACCK^PRCAACC(RCBILLDA),$P($G(^PRCA(430,RCBILLDA,0)),"^",2)'=26 D
. ; get the bills fund
. ;PRCA*4.5*338 Calculate fund only if it is not stored in the bill
. S RCFUND=$$GET1^DIQ(430,BILLDA_",",203)
. I RCFUND="" S RCFUND=$$GETFUNDB^RCXFMSUF(BILLDA,1)
. ;end PRCA*4.5*338
. S RCFUND=$$ADJFUND^RCRJRCO(RCFUND) ; may remove the line after 10/1/03
. S CATEGORY=+$P($G(^PRCA(430,RCBILLDA,0)),"^",2),RCCATNM=$$GET1^DIQ(430.2,CATEGORY_",",.01) ; retrieve CAT name PRCA*4.5*338
. ;
. S TYPE=37
. ; special type for tort feasor
. I RCCATNM["TORT" S TYPE="39" ;Using the category name to look for TORTs - PRCA*4.5*338
. S ARACTDT=+$P($P($G(^PRCA(430,RCBILLDA,6)),"^",21),".")
. ; DBIA #4385 activated on 31-Mar-2004
. S MRATYPE=$$MRATYPE^IBCEMU2(RCBILLDA,ARACTDT)
. ; for contract adjustments (criter2=22), the type is 38 for pre-
. ; MRA, 4N for post-MRA non-Medicare and 08 for post-MRA Medicare
. I RCRITER2=22 S TYPE=$S(MRATYPE=1:38,MRATYPE=2:"08",1:"4N") ;Aging bucket increase modified in PRCA*4.5*334
. ; store dollars to mccf and hsif
. I RCTOMCCF S ^TMP($J,"RCRJRCOLWR",TYPE,RCFUND,RCRSC)=$G(^TMP($J,"RCRJRCOLWR",TYPE,RCFUND,RCRSC))+RCTOMCCF
. I RCTOHSIF S ^TMP($J,"RCRJRCOLWR",TYPE,5358.1,$S(RCRSC="8BZZ":"8B1Z",1:"8C1Z"))=$G(^TMP($J,"RCRJRCOLWR",TYPE,5358.1,$S(RCRSC="8BZZ":"8B1Z",1:"8C1Z")))+RCTOHSIF
;
; store the interest, admin, mf, cc on the WR code sheet
; interest (type P4; fund 1435; rsc 8047)
I $P(RCVALUE,"^",2) S ^TMP($J,"RCRJRCOLWR","P4",1435,8047)=$G(^TMP($J,"RCRJRCOLWR","P4",1435,8047))+$P(RCVALUE,"^",2)
; admin (type P4; fund 3220; rsc 8046)
I $P(RCVALUE,"^",3) S ^TMP($J,"RCRJRCOLWR","P4",3220,8046)=$G(^TMP($J,"RCRJRCOLWR","P4",3220,8046))+$P(RCVALUE,"^",3)
; mf + cc (type P4; fund 0869; rsc 8048)
S %=$P(RCVALUE,"^",4)+$P(RCVALUE,"^",5)
I % S ^TMP($J,"RCRJRCOLWR","P4","0869",8048)=$G(^TMP($J,"RCRJRCOLWR","P4","0869",8048))+%
Q
;
;
NDBSTORE(RCBILLDA,RCVALUE,RCRITER2) ; store the data for the NDB
; returns a 1 if the bill has not been counted
; returns a 0 if the bill has been counted
N %,CRITERIA
;
; this line of code will prevent duplicate counts if a sites cross
; references in file 430 (actdt and asdt) are duplicated (incorrect)
I RCRITER2<15,$D(^TMP($J,"RCRJRCOL","COUNT",RCBILLDA,RCRITER2)) Q 0 ; Aging bucket increase modified in PRCA*4.5*334
;
; get a bills criteria 1,3,4,5
S CRITERIA=$G(^TMP($J,"RCRJRCOL","CRITERIA",RCBILLDA))
I CRITERIA="" S CRITERIA=$$CRITERIA^RCRJRCOL(RCBILLDA),^TMP($J,"RCRJRCOL","CRITERIA",RCBILLDA)=CRITERIA
S $P(CRITERIA,"-",2)=RCRITER2
;
; store results for ndb
S %=$G(@DATASTOR)
S $P(%,"^")=$P(%,"^")+1
S $P(%,"^",2)=$P(%,"^",2)+$P(RCVALUE,"^")
S $P(%,"^",3)=$P(%,"^",3)+$P(RCVALUE,"^",2)+$P(RCVALUE,"^",3)+$P(RCVALUE,"^",4)+$P(RCVALUE,"^",5)
S @DATASTOR=%
;
; keep a count of current receivables counted
S ^TMP($J,"RCRJRCOL","COUNT",RCBILLDA,RCRITER2)=""
S ^TMP($J,"RCRJRCOL","CRIT2",RCRITER2,RCBILLDA)=""
Q 1
;
;
MCCFHSIF(RCBILLDA,RCVALUE,RCRSC,ASOFDATE) ; calculate the amount that goes
;
; to mccf and hsif
;
; returns RCTOMCCF and RCTOHSIF as the outstanding balance to mccf
; and the outstanding balance to hsif
N MCCFHSIF
;
S RCTOMCCF=$P(RCVALUE,"^"),RCTOHSIF=0
;
I $$NOHSIF^RCRJRCO() Q ; disabled HSIF
;
; if revenue source code is not 8BZZ or 8CZZ then it all goes to mccf
I RCRSC="8BZZ"!(RCRSC="8CZZ") D
. ; get the amount for each fund mccf and hsif
. ; this call returns the total amount owed to mccf (piece 1),
. ; total amount owed to hsif (piece 2), total amount paid
. ; to mccf (piece 3), total amount paid to hsif (piece 4).
. ; for outstanding balance you must subtract the payment in
. ; pieces 3 and 4 which are returned as negative amounts.
. S MCCFHSIF=$$BILLFUND^RCBMILLC(RCBILLDA,ASOFDATE)
. S RCTOMCCF=$P(MCCFHSIF,"^",1)+$P(MCCFHSIF,"^",3)
. S RCTOHSIF=$P(MCCFHSIF,"^",2)+$P(MCCFHSIF,"^",4)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCRJRCOC 11217 printed Sep 23, 2025@19:24:20 Page 2
RCRJRCOC ;WISC/RFJ/BGJ-count current receivables ; 11/2/10 10:53am
+1 ;;4.5;Accounts Receivable;**156,170,182,203,220,138,239,272,273,334,335,338**;Mar 20, 1995;Build 69
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ; IA 4385 for call to $$MRATYPE^IBCEMU2
+4 QUIT
+5 ;
+6 ;
CURRENT(RCBILLDA,RCVALUE) ; count current bills balance
+1 ; rcvalue = prin ^ int ^ admin ^ mf ^ cc
+2 ;
+3 NEW %,RCFUND,RCRSC,RCTOHSIF,RCTOMCCF,SGL,TYPE,MRATYPE,ARACTDT,CATEGORY,RCRHITYP,RCCATNM
+4 ;
+5 ; calculate the rsc for the bill. the rsc is only used for
+6 ; mccf bills
+7 SET RCRSC=""
+8 ;PRCA*4.5*338 - Modified the code to only recalculate RSCs if none currently calculated.
+9 SET RCRSC=$$GET1^DIQ(430,BILLDA_",",255)
+10 if RCRSC=""
SET RCRSC=$$GET1^DIQ(430,BILLDA_",",255.1)
+11 IF $$ACCK^PRCAACC(RCBILLDA)
if RCRSC=""
SET RCRSC=$$CALCRSC^RCXFMSUR(RCBILLDA)
+12 ;
+13 ; calculate the amount that goes to mccf and hsif
+14 DO MCCFHSIF(RCBILLDA,RCVALUE,RCRSC,DATEEND+1)
+15 ;
+16 ; store the data for the ndb, if a 0 is returned by the function,
+17 ; then the bill has already been counted as a current receivable,quit
+18 IF '$$NDBSTORE(RCBILLDA,RCVALUE,1)
QUIT
+19 ;
+20 ; store results for FMS SV document for accrued bills only
+21 ; do not include prepayments (26)
+22 IF $$ACCK^PRCAACC(RCBILLDA)
IF $PIECE($GET(^PRCA(430,RCBILLDA,0)),"^",2)'=26
Begin DoDot:1
+23 ; get the bills fund and category
+24 ;PRCA*4.5*338 Calculate fund only if it is not stored in the bill
+25 SET RCFUND=$$GET1^DIQ(430,BILLDA_",",203)
+26 IF RCFUND=""
SET RCFUND=$$GETFUNDB^RCXFMSUF(BILLDA,1)
+27 ;end PRCA*4.5*338
+28 ; may remove the line after 10/1/03
SET RCFUND=$$ADJFUND^RCRJRCO(RCFUND)
+29 ; retrieve CAT name PRCA*4.5*338
SET CATEGORY=+$PIECE($GET(^PRCA(430,RCBILLDA,0)),"^",2)
SET RCCATNM=$$GET1^DIQ(430.2,CATEGORY_",",.01)
+30 ;
+31 ; ----- this code is used to set up the SV code sheet -----
+32 SET TYPE=21
+33 ; special type for tort feasor
+34 ;Using the category name to look for TORTs - PRCA*4.5*338
IF RCCATNM["TORT"
SET TYPE="2A"
+35 ;
+36 ; Get ARACTDT=AR Date Active for bill
+37 SET ARACTDT=+$PIECE($PIECE($GET(^PRCA(430,RCBILLDA,6)),"^",21),".")
+38 ; determine Receivable Type: 1=pre-MRA, 2=post-MRA Medicre, 3=post-MRA non-Medicare
+39 ; DBIA #4385 activated on 31-Mar-2004
+40 SET MRATYPE=$$MRATYPE^IBCEMU2(RCBILLDA,ARACTDT)
+41 ; set TYPE to 2F for post-MRA Medicare bills or to 2L for
+42 ; post-MRA non-Medicare bills (for RHI receivables only)
+43 ; PRCA*4.5*338 moved TYPE set for RHI to function call to ensure Community Care RSCs are captured correctly.
+44 SET RCRHITYP=$$RHITYPE(RCRSC,MRATYPE,RCCATNM)
if +RCRHITYP
SET TYPE=$PIECE(RCRHITYP,U,2)
+45 ;
+46 ; store dollars to mccf and hsif
+47 IF RCTOMCCF
SET ^TMP($JOB,"RCRJRCOLSV",TYPE,RCFUND,RCRSC)=$GET(^TMP($JOB,"RCRJRCOLSV",TYPE,RCFUND,RCRSC))+RCTOMCCF
+48 IF RCTOHSIF
SET ^TMP($JOB,"RCRJRCOLSV",21,5358.1,$SELECT(RCRSC="8BZZ":"8B1Z",1:"8C1Z"))=$GET(^TMP($JOB,"RCRJRCOLSV",21,5358.1,$SELECT(RCRSC="8BZZ":"8B1Z",1:"8C1Z")))+RCTOHSIF
+49 ;
+50 ; ----- this code is used to build the user report
+51 SET %=+$PIECE($PIECE($GET(^PRCA(430,RCBILLDA,6)),"^",21),".")
+52 SET ^TMP($JOB,"RCRJRCOLREPORT",%,RCBILLDA)=$PIECE(RCVALUE,"^")_"^"_($PIECE(RCVALUE,"^",2)+$PIECE(RCVALUE,"^",3)+$PIECE(RCVALUE,"^",4)+$PIECE(RCVALUE,"^",5))_"^SV"_TYPE
+53 IF RCTOMCCF
DO STORE^RCRJRCOU(BILLDA,DATEBEG,DATEEND,ARACTDT,CATEGORY,"SV"_TYPE,RCFUND,RCRSC,RCVALUE)
+54 IF RCTOHSIF
DO STORE^RCRJRCOU(BILLDA,DATEBEG,DATEEND,ARACTDT,CATEGORY,"SV21","5358.1",$SELECT(RCRSC="8BZZ":"8B1Z",1:"8C1Z"),RCVALUE)
+55 ;
+56 ; ----- this code is used to build the OIG extract, piece 3 = GL acct
+57 SET ^TMP($JOB,"RCRJROIG",RCBILLDA)=$PIECE(RCVALUE,"^")_"^"_($PIECE(RCVALUE,"^",2)+$PIECE(RCVALUE,"^",3)+$PIECE(RCVALUE,"^",4)+$PIECE(RCVALUE,"^",5))_"^"_$SELECT(TYPE="2A":1333,TYPE="2F":"13H1",TYPE="2L":"13N1",1:1311)
+58 ;
+59 ; ----- this code is used to set up medicare supplemental SVs
+60 SET %=$GET(^PRCA(430,RCBILLDA,13))
+61 ; medicare contract adjustment field 131 for bills activated in AR during the month the ARDC is running
+62 ;
IF $PIECE(%,"^",1)
IF ARACTDT'<DATEBEG
Begin DoDot:2
+63 SET ^TMP($JOB,"RCRJRCOLSV",17)=$GET(^TMP($JOB,"RCRJRCOLSV",17))+$PIECE(%,"^",1)
+64 SET ^TMP($JOB,"RCRJRCOLSV",17,RCFUND,RCRSC)=$GET(^TMP($JOB,"RCRJRCOLSV",17,RCFUND,RCRSC))+$PIECE(%,"^",1)
End DoDot:2
+65 ; medicare unreimbursable medicare expense field 132 for bills activated in AR during the month the ARDC is running
+66 ;
IF $PIECE(%,"^",2)
IF ARACTDT'<DATEBEG
Begin DoDot:2
+67 SET ^TMP($JOB,"RCRJRCOLSV",18)=$GET(^TMP($JOB,"RCRJRCOLSV",18))+$PIECE(%,"^",2)
+68 SET ^TMP($JOB,"RCRJRCOLSV",18,RCFUND,RCRSC)=$GET(^TMP($JOB,"RCRJRCOLSV",18,RCFUND,RCRSC))+$PIECE(%,"^",2)
End DoDot:2
+69 ;
+70 ; ----- this code is used to set up the bad debt report -----
+71 SET SGL=$$BDRSGL^RCRJRBD(CATEGORY,RCFUND,MRATYPE)
+72 ; store dollars to mccf and hsif. both are sgl 1319 so 1319.1 is
+73 ; used to put hsif in a subset of 1319
+74 IF RCTOMCCF
SET ^TMP($JOB,"RCRJRBD",SGL)=$GET(^TMP($JOB,"RCRJRBD",SGL))+RCTOMCCF
+75 IF RCTOHSIF
SET ^TMP($JOB,"RCRJRBD",1319.1)=$GET(^TMP($JOB,"RCRJRBD",1319.1))+RCTOHSIF
End DoDot:1
+76 ;
+77 ; store the interest, admin, mf, cc on the SV code sheet
+78 ; interest (type P2; fund 1435; rsc 8047)
+79 IF $PIECE(RCVALUE,"^",2)
SET ^TMP($JOB,"RCRJRCOLSV","P2",1435,8047)=$GET(^TMP($JOB,"RCRJRCOLSV","P2",1435,8047))+$PIECE(RCVALUE,"^",2)
+80 ; admin (type P2; fund 3220; rsc 8046)
+81 IF $PIECE(RCVALUE,"^",3)
SET ^TMP($JOB,"RCRJRCOLSV","P2",3220,8046)=$GET(^TMP($JOB,"RCRJRCOLSV","P2",3220,8046))+$PIECE(RCVALUE,"^",3)
+82 ; mf + cc (type P2; fund 0869; rsc 8048)
+83 SET %=$PIECE(RCVALUE,"^",4)+$PIECE(RCVALUE,"^",5)
+84 IF %
SET ^TMP($JOB,"RCRJRCOLSV","P2","0869",8048)=$GET(^TMP($JOB,"RCRJRCOLSV","P2","0869",8048))+%
+85 QUIT
+86 ;
RHITYPE(RCRSC,MRATYPE,RCCATNM) ;
+1 ; Input - RCRSC - Revenue Source Code from a Bill
+2 ; RCMRATYP - Type of MRA as determined by the call to $$MRATYPE^IBCEMU2
+3 ; Output - Is it a RHI Bill (0 - No, 1 - Yes) ^ SV Type to return (2F or 2L) [required if an RHI Bill]
+4 ;
+5 NEW RCTYPE
+6 SET RCTYPE=0
+7 IF MRATYPE>1
Begin DoDot:1
+8 ; This specific RSC is a TORT RSC for the CHOICE program
if RCRSC="85CC"
QUIT
+9 IF $EXTRACT(RCRSC,1,2)=85!($EXTRACT(RCRSC,1,2)="8R")
SET RCTYPE="1^"_$SELECT(MRATYPE=2:"2F",1:"2L")
QUIT
+10 IF RCCATNM["THIRD PARTY"
Begin DoDot:2
+11 ;Exclude CHAMPVA
if RCCATNM["CHAMPVA"
QUIT
+12 ;Exclude TRICARE
if RCCATNM["TRICARE"
QUIT
+13 ;otherwise this is a Community Care Bill, set the SV type
+14 SET RCTYPE="1^"_$SELECT(MRATYPE=2:"2F",1:"2L")
End DoDot:2
QUIT
End DoDot:1
+15 QUIT RCTYPE
+16 ;
WRITEOFF(RCBILLDA,RCVALUE,RCRITER2) ; count write offs
+1 ; rcvalue = prin ^ int ^ admin ^ mf ^ cc
+2 ; rcriter2 = write off criteria tracked in ndb
+3 ;
+4 NEW %,RCFUND,RCRSC,RCTOHSIF,RCTOMCCF,TYPE,MRATYPE,ARACTDT
+5 ;
+6 ; calculate the rsc for the bill. the rsc is only used for
+7 ; mccf bills
+8 SET RCRSC=""
+9 ;PRCA*4.5*338 - Modified the code to only recalculate RSCs if none currently calculated.
+10 SET RCRSC=$$GET1^DIQ(430,BILLDA_",",255)
+11 if RCRSC=""
SET RCRSC=$$GET1^DIQ(430,BILLDA_",",255.1)
+12 IF $$ACCK^PRCAACC(RCBILLDA)
if RCRSC=""
SET RCRSC=$$CALCRSC^RCXFMSUR(RCBILLDA)
+13 ;
+14 ; calculate the amount that goes to mccf and hsif
+15 DO MCCFHSIF(RCBILLDA,RCVALUE,RCRSC,DATEEND+1)
+16 ;
+17 ; store the data for the ndb, if a 0 is returned by the function,
+18 ; then the bill has already been counted as a current receivable,quit
+19 IF '$$NDBSTORE(RCBILLDA,RCVALUE,RCRITER2)
QUIT
+20 ;
+21 ; store results for FMS WR document
+22 ; do not include prepayments (26)
+23 IF $$ACCK^PRCAACC(RCBILLDA)
IF $PIECE($GET(^PRCA(430,RCBILLDA,0)),"^",2)'=26
Begin DoDot:1
+24 ; get the bills fund
+25 ;PRCA*4.5*338 Calculate fund only if it is not stored in the bill
+26 SET RCFUND=$$GET1^DIQ(430,BILLDA_",",203)
+27 IF RCFUND=""
SET RCFUND=$$GETFUNDB^RCXFMSUF(BILLDA,1)
+28 ;end PRCA*4.5*338
+29 ; may remove the line after 10/1/03
SET RCFUND=$$ADJFUND^RCRJRCO(RCFUND)
+30 ; retrieve CAT name PRCA*4.5*338
SET CATEGORY=+$PIECE($GET(^PRCA(430,RCBILLDA,0)),"^",2)
SET RCCATNM=$$GET1^DIQ(430.2,CATEGORY_",",.01)
+31 ;
+32 SET TYPE=37
+33 ; special type for tort feasor
+34 ;Using the category name to look for TORTs - PRCA*4.5*338
IF RCCATNM["TORT"
SET TYPE="39"
+35 SET ARACTDT=+$PIECE($PIECE($GET(^PRCA(430,RCBILLDA,6)),"^",21),".")
+36 ; DBIA #4385 activated on 31-Mar-2004
+37 SET MRATYPE=$$MRATYPE^IBCEMU2(RCBILLDA,ARACTDT)
+38 ; for contract adjustments (criter2=22), the type is 38 for pre-
+39 ; MRA, 4N for post-MRA non-Medicare and 08 for post-MRA Medicare
+40 ;Aging bucket increase modified in PRCA*4.5*334
IF RCRITER2=22
SET TYPE=$SELECT(MRATYPE=1:38,MRATYPE=2:"08",1:"4N")
+41 ; store dollars to mccf and hsif
+42 IF RCTOMCCF
SET ^TMP($JOB,"RCRJRCOLWR",TYPE,RCFUND,RCRSC)=$GET(^TMP($JOB,"RCRJRCOLWR",TYPE,RCFUND,RCRSC))+RCTOMCCF
+43 IF RCTOHSIF
SET ^TMP($JOB,"RCRJRCOLWR",TYPE,5358.1,$SELECT(RCRSC="8BZZ":"8B1Z",1:"8C1Z"))=$GET(^TMP($JOB,"RCRJRCOLWR",TYPE,5358.1,$SELECT(RCRSC="8BZZ":"8B1Z",1:"8C1Z")))+RCTOHSIF
End DoDot:1
+44 ;
+45 ; store the interest, admin, mf, cc on the WR code sheet
+46 ; interest (type P4; fund 1435; rsc 8047)
+47 IF $PIECE(RCVALUE,"^",2)
SET ^TMP($JOB,"RCRJRCOLWR","P4",1435,8047)=$GET(^TMP($JOB,"RCRJRCOLWR","P4",1435,8047))+$PIECE(RCVALUE,"^",2)
+48 ; admin (type P4; fund 3220; rsc 8046)
+49 IF $PIECE(RCVALUE,"^",3)
SET ^TMP($JOB,"RCRJRCOLWR","P4",3220,8046)=$GET(^TMP($JOB,"RCRJRCOLWR","P4",3220,8046))+$PIECE(RCVALUE,"^",3)
+50 ; mf + cc (type P4; fund 0869; rsc 8048)
+51 SET %=$PIECE(RCVALUE,"^",4)+$PIECE(RCVALUE,"^",5)
+52 IF %
SET ^TMP($JOB,"RCRJRCOLWR","P4","0869",8048)=$GET(^TMP($JOB,"RCRJRCOLWR","P4","0869",8048))+%
+53 QUIT
+54 ;
+55 ;
NDBSTORE(RCBILLDA,RCVALUE,RCRITER2) ; store the data for the NDB
+1 ; returns a 1 if the bill has not been counted
+2 ; returns a 0 if the bill has been counted
+3 NEW %,CRITERIA
+4 ;
+5 ; this line of code will prevent duplicate counts if a sites cross
+6 ; references in file 430 (actdt and asdt) are duplicated (incorrect)
+7 ; Aging bucket increase modified in PRCA*4.5*334
IF RCRITER2<15
IF $DATA(^TMP($JOB,"RCRJRCOL","COUNT",RCBILLDA,RCRITER2))
QUIT 0
+8 ;
+9 ; get a bills criteria 1,3,4,5
+10 SET CRITERIA=$GET(^TMP($JOB,"RCRJRCOL","CRITERIA",RCBILLDA))
+11 IF CRITERIA=""
SET CRITERIA=$$CRITERIA^RCRJRCOL(RCBILLDA)
SET ^TMP($JOB,"RCRJRCOL","CRITERIA",RCBILLDA)=CRITERIA
+12 SET $PIECE(CRITERIA,"-",2)=RCRITER2
+13 ;
+14 ; store results for ndb
+15 SET %=$GET(@DATASTOR)
+16 SET $PIECE(%,"^")=$PIECE(%,"^")+1
+17 SET $PIECE(%,"^",2)=$PIECE(%,"^",2)+$PIECE(RCVALUE,"^")
+18 SET $PIECE(%,"^",3)=$PIECE(%,"^",3)+$PIECE(RCVALUE,"^",2)+$PIECE(RCVALUE,"^",3)+$PIECE(RCVALUE,"^",4)+$PIECE(RCVALUE,"^",5)
+19 SET @DATASTOR=%
+20 ;
+21 ; keep a count of current receivables counted
+22 SET ^TMP($JOB,"RCRJRCOL","COUNT",RCBILLDA,RCRITER2)=""
+23 SET ^TMP($JOB,"RCRJRCOL","CRIT2",RCRITER2,RCBILLDA)=""
+24 QUIT 1
+25 ;
+26 ;
MCCFHSIF(RCBILLDA,RCVALUE,RCRSC,ASOFDATE) ; calculate the amount that goes
+1 ;
+2 ; to mccf and hsif
+3 ;
+4 ; returns RCTOMCCF and RCTOHSIF as the outstanding balance to mccf
+5 ; and the outstanding balance to hsif
+6 NEW MCCFHSIF
+7 ;
+8 SET RCTOMCCF=$PIECE(RCVALUE,"^")
SET RCTOHSIF=0
+9 ;
+10 ; disabled HSIF
IF $$NOHSIF^RCRJRCO()
QUIT
+11 ;
+12 ; if revenue source code is not 8BZZ or 8CZZ then it all goes to mccf
+13 IF RCRSC="8BZZ"!(RCRSC="8CZZ")
Begin DoDot:1
+14 ; get the amount for each fund mccf and hsif
+15 ; this call returns the total amount owed to mccf (piece 1),
+16 ; total amount owed to hsif (piece 2), total amount paid
+17 ; to mccf (piece 3), total amount paid to hsif (piece 4).
+18 ; for outstanding balance you must subtract the payment in
+19 ; pieces 3 and 4 which are returned as negative amounts.
+20 SET MCCFHSIF=$$BILLFUND^RCBMILLC(RCBILLDA,ASOFDATE)
+21 SET RCTOMCCF=$PIECE(MCCFHSIF,"^",1)+$PIECE(MCCFHSIF,"^",3)
+22 SET RCTOHSIF=$PIECE(MCCFHSIF,"^",2)+$PIECE(MCCFHSIF,"^",4)
End DoDot:1
+23 QUIT
