Routine: RCRJRCOC

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

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))+%

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))+%

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)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCRJRCOC   11217     printed  Mar 13, 2025@20:52:52                                                                                                                                                                                                   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

RCRJRCOC.m