RCRJRCO1 ;WISC/RFJ/BGJ-continuation of ar data collector ;1 Mar 97
;;4.5;Accounts Receivable;**68,96,101,120,103,153,156,170,182,203,320,340**;Mar 20, 1995;Build 9
;;Per VA Directive 6402, this routine should not be modified.
Q
;
;
START ; calculate ndb values from file 433 transactions
; needs datebeg, dateend
; total is total by category
;
N ADMIN,BILLDA,DATE,INTEREST,PRINBAL,TRANDA,TRANTYPE,VALUE,RCNOHSIF
;
S RCNOHSIF=$$NOHSIF^RCRJRCO() ; no HSIF (disabled)
;
F TRANTYPE=1,2,3,8,9,10,11,12,13,14,34,35,41,43,73,74 D ; *340 added 73 and 74
. S DATE=DATEBEG-1
. F S DATE=$O(^PRCA(433,"AT",TRANTYPE,DATE)) Q:'DATE!(DATE>DATEEND) D
. . S TRANDA=0
. . F S TRANDA=$O(^PRCA(433,"AT",TRANTYPE,DATE,TRANDA)) Q:'TRANDA D
. . . S BILLDA=+$P($G(^PRCA(433,TRANDA,0)),"^",2) I 'BILLDA Q
. . . ; bill not linked to a site
. . . I '$P($G(^PRCA(430,BILLDA,0)),"^",12) Q
. . . ;
. . . ; get a transactions balance
. . . S VALUE=$$TRANBAL^RCRJRCOT(TRANDA) I VALUE="" Q
. . . S PRINBAL=$P(VALUE,"^"),INTEREST=$P(VALUE,"^",2),ADMIN=$P(VALUE,"^",3)+$P(VALUE,"^",4)+$P(VALUE,"^",5)
. . . ;
. . . D @TRANTYPE
Q
;
;
1 ; increase adjustments
;D SETTOTAL(14,PRINBAL,0)
D SETTOTAL(16,PRINBAL,0) ;PRCA*4.5*320 Increease aging buckets by 2
Q
;
;
2 ; payment in partial
N CATEGORY
; prepayment transaction (field #20)
I $P($G(^PRCA(433,TRANDA,5)),"^") D Q
. ;D SETTOTAL(21,PRINBAL,0)
. D SETTOTAL(23,PRINBAL,0) ;PRCA*4.5*320 Increease aging buckets by 2
. ;I INTEREST D SETTOTAL(38,INTEREST,0)
. I INTEREST D SETTOTAL(40,INTEREST,0)
. ;I ADMIN D SETTOTAL(39,ADMIN,0)
. I ADMIN D SETTOTAL(41,ADMIN,0)
;
; check to see if payment is rx copay and is split between
; mccf and hsif. if the bill has been run through the
; calculator, do it now and report the mccf split to the ndb.
; the amount owed to mccf is in piece 3 and is returned negative
S CATEGORY=$P(^PRCA(430,BILLDA,0),"^",2)
I 'RCNOHSIF,PRINBAL,(CATEGORY=22!(CATEGORY=23)),'$D(^TMP($J,"RCBMILLDATA",BILLDA,TRANDA)) D
. S %=$$BILLFUND^RCBMILLC(BILLDA)
;
; changed by patch PRCA*4.5*182 to no longer separate the mccf and
; hsif components. the entire amount is now reported to the ndb.
;
;. S PRINBAL=-$P($G(^TMP($J,"RCBMILLDATA",BILLDA,TRANDA)),"^",3)
;
; partial payments (trantype=2), full payments (trantype=34)
;D SETTOTAL($S(TRANTYPE=2:19,1:18),PRINBAL,0)
D SETTOTAL($S(TRANTYPE=2:21,1:20),PRINBAL,0)
;I INTEREST D SETTOTAL(38,INTEREST,0)
I INTEREST D SETTOTAL(40,INTEREST,0)
;I ADMIN D SETTOTAL(39,ADMIN,0)
I ADMIN D SETTOTAL(41,ADMIN,0)
;
; irs, district counsel, dept of justice (#7)
S %=$P($G(^PRCA(433,TRANDA,0)),"^",7) I %="" Q
;I %="IRS" D SETTOTAL(28,PRINBAL,0) Q
I %="IRS" D SETTOTAL(30,PRINBAL,0) Q ;PRCA*4.5*320 Increease aging buckets by 2 (on several lines below)
;I %="DC" D SETTOTAL(31,PRINBAL,0) Q
I %="DC" D SETTOTAL(33,PRINBAL,0) Q
;I %="DOJ" D SETTOTAL(34,PRINBAL,0) Q
I %="DOJ" D SETTOTAL(36,PRINBAL,0) Q
Q
;
;
3 ; refer to district counsel
;D SETTOTAL(30,PRINBAL,0)
D SETTOTAL(32,PRINBAL,0)
Q
;
;
8 ; terminate by fiscal officer
;D WRITEOFF^RCRJRCOC(BILLDA,VALUE,$S(TRANTYPE=8:25,1:24))
D WRITEOFF^RCRJRCOC(BILLDA,VALUE,$S(TRANTYPE=8:27,1:26))
; decrease in number of debts
;I '$D(^TMP($J,"RCRJRCOL","COUNT",BILLDA,17)) D SETTOTAL(17,0,0)
I '$D(^TMP($J,"RCRJRCOL","COUNT",BILLDA,19)) D SETTOTAL(19,0,0)
Q
;
;
9 ; terminate by compromise
D 8
Q
;
;
10 ; payment waived in full
;D WRITEOFF^RCRJRCOC(BILLDA,VALUE,22)
D WRITEOFF^RCRJRCOC(BILLDA,VALUE,24)
Q
;
;
11 ; payment waived in partial
;D WRITEOFF^RCRJRCOC(BILLDA,VALUE,23)
D WRITEOFF^RCRJRCOC(BILLDA,VALUE,25)
Q
;
;
12 ; admin cost / charge
; interest/admin added
;I INTEREST>0 D SETTOTAL(40,INTEREST,0)
I INTEREST>0 D SETTOTAL(42,INTEREST,0)
;I ADMIN>0 D SETTOTAL(41,ADMIN,0)
I ADMIN>0 D SETTOTAL(43,ADMIN,0)
; interest/admin cost exempt
;I INTEREST<0 D SETTOTAL(42,-INTEREST,0)
I INTEREST<0 D SETTOTAL(44,-INTEREST,0)
;I ADMIN<0 D SETTOTAL(42,-ADMIN,0)
I ADMIN<0 D SETTOTAL(44,-ADMIN,0)
Q
;
;
13 ; interest / admin charge
D 12
Q
;
;
14 ; exempt interest / admin cost
;D SETTOTAL(42,INTEREST,0)
D SETTOTAL(44,INTEREST,0)
Q
;
;
34 ; payment in full
D 2
; decrease in number of debts
;I '$D(^TMP($J,"RCRJRCOL","COUNT",BILLDA,17)) D SETTOTAL(17,0,0)
I '$D(^TMP($J,"RCRJRCOL","COUNT",BILLDA,19)) D SETTOTAL(19,0,0)
Q
;
;
35 ; decrease adjustment
N CONTRACT
; contractual adjustment (field #88)
S CONTRACT=$P($G(^PRCA(433,TRANDA,8)),"^",8)
;I CONTRACT D WRITEOFF^RCRJRCOC(BILLDA,VALUE,20) Q
I CONTRACT D WRITEOFF^RCRJRCOC(BILLDA,VALUE,22) Q
;D SETTOTAL(16,PRINBAL,0)
D SETTOTAL(18,PRINBAL,0)
Q
;
;
41 ; refund
;D SETTOTAL(43,PRINBAL,0)
D SETTOTAL(45,PRINBAL,0)
Q
;
;
43 ; re-establishment
;D SETTOTAL(13,PRINBAL,INTEREST+ADMIN)
D SETTOTAL(15,PRINBAL,INTEREST+ADMIN)
Q
;
;
73 ; cs increase adjustment - added with *340
D 1
Q
;
;
74 ; cs admin.cost charge - added with *340
D 12
Q
;
;
SETTOTAL(CRITER2,AMOUNT,INTEREST) ; store results
N RSC,TYPE
;
; this line of code will prevent duplicate counts if a sites cross
; references in file 430 (actdt and asdt) are duplicated (incorrect)
;I CRITER2<13,$D(^TMP($J,"RCRJRCOL","COUNT",BILLDA,CRITER2)) Q
I CRITER2<15,$D(^TMP($J,"RCRJRCOL","COUNT",BILLDA,CRITER2)) Q
;
; get a bills criteria 1,3,4,5
S CRITERIA=$G(^TMP($J,"RCRJRCOL","CRITERIA",BILLDA))
I CRITERIA="" S CRITERIA=$$CRITERIA^RCRJRCOL(BILLDA),^TMP($J,"RCRJRCOL","CRITERIA",BILLDA)=CRITERIA
;
; store for ndb
S $P(CRITERIA,"-",2)=CRITER2
;
; store results for ndb
S %=$G(@DATASTOR)
S $P(%,"^")=$P(%,"^")+1
S $P(%,"^",2)=$P(%,"^",2)+AMOUNT
S $P(%,"^",3)=$P(%,"^",3)+INTEREST
S @DATASTOR=%
;
; keep a count of which category (criter2) a bill is counted in
S ^TMP($J,"RCRJRCOL","COUNT",BILLDA,CRITER2)=""
S ^TMP($J,"RCRJRCOL","CRIT2",CRITER2,BILLDA)=""
;
; pick up bills with activity which may not have been picked up as
; a current receivable because of the wrong status date
;I CRITER2>13,CRITER2'=17,'$D(^TMP($J,"RCRJRCOL","COUNT",BILLDA,1)),'$D(^TMP($J,"RCRJRCOL","COUNT",BILLDA,17)) D CURRENT^RCRJRCOB(BILLDA,DATEEND,AYEAROLD)
I CRITER2>15,CRITER2'=19,'$D(^TMP($J,"RCRJRCOL","COUNT",BILLDA,1)),'$D(^TMP($J,"RCRJRCOL","COUNT",BILLDA,19)) D CURRENT^RCRJRCOB(BILLDA,DATEEND,AYEAROLD)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCRJRCO1 6631 printed Oct 16, 2024@17:48:59 Page 2
RCRJRCO1 ;WISC/RFJ/BGJ-continuation of ar data collector ;1 Mar 97
+1 ;;4.5;Accounts Receivable;**68,96,101,120,103,153,156,170,182,203,320,340**;Mar 20, 1995;Build 9
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
START ; calculate ndb values from file 433 transactions
+1 ; needs datebeg, dateend
+2 ; total is total by category
+3 ;
+4 NEW ADMIN,BILLDA,DATE,INTEREST,PRINBAL,TRANDA,TRANTYPE,VALUE,RCNOHSIF
+5 ;
+6 ; no HSIF (disabled)
SET RCNOHSIF=$$NOHSIF^RCRJRCO()
+7 ;
+8 ; *340 added 73 and 74
FOR TRANTYPE=1,2,3,8,9,10,11,12,13,14,34,35,41,43,73,74
Begin DoDot:1
+9 SET DATE=DATEBEG-1
+10 FOR
SET DATE=$ORDER(^PRCA(433,"AT",TRANTYPE,DATE))
if 'DATE!(DATE>DATEEND)
QUIT
Begin DoDot:2
+11 SET TRANDA=0
+12 FOR
SET TRANDA=$ORDER(^PRCA(433,"AT",TRANTYPE,DATE,TRANDA))
if 'TRANDA
QUIT
Begin DoDot:3
+13 SET BILLDA=+$PIECE($GET(^PRCA(433,TRANDA,0)),"^",2)
IF 'BILLDA
QUIT
+14 ; bill not linked to a site
+15 IF '$PIECE($GET(^PRCA(430,BILLDA,0)),"^",12)
QUIT
+16 ;
+17 ; get a transactions balance
+18 SET VALUE=$$TRANBAL^RCRJRCOT(TRANDA)
IF VALUE=""
QUIT
+19 SET PRINBAL=$PIECE(VALUE,"^")
SET INTEREST=$PIECE(VALUE,"^",2)
SET ADMIN=$PIECE(VALUE,"^",3)+$PIECE(VALUE,"^",4)+$PIECE(VALUE,"^",5)
+20 ;
+21 DO @TRANTYPE
End DoDot:3
End DoDot:2
End DoDot:1
+22 QUIT
+23 ;
+24 ;
1 ; increase adjustments
+1 ;D SETTOTAL(14,PRINBAL,0)
+2 ;PRCA*4.5*320 Increease aging buckets by 2
DO SETTOTAL(16,PRINBAL,0)
+3 QUIT
+4 ;
+5 ;
2 ; payment in partial
+1 NEW CATEGORY
+2 ; prepayment transaction (field #20)
+3 IF $PIECE($GET(^PRCA(433,TRANDA,5)),"^")
Begin DoDot:1
+4 ;D SETTOTAL(21,PRINBAL,0)
+5 ;PRCA*4.5*320 Increease aging buckets by 2
DO SETTOTAL(23,PRINBAL,0)
+6 ;I INTEREST D SETTOTAL(38,INTEREST,0)
+7 IF INTEREST
DO SETTOTAL(40,INTEREST,0)
+8 ;I ADMIN D SETTOTAL(39,ADMIN,0)
+9 IF ADMIN
DO SETTOTAL(41,ADMIN,0)
End DoDot:1
QUIT
+10 ;
+11 ; check to see if payment is rx copay and is split between
+12 ; mccf and hsif. if the bill has been run through the
+13 ; calculator, do it now and report the mccf split to the ndb.
+14 ; the amount owed to mccf is in piece 3 and is returned negative
+15 SET CATEGORY=$PIECE(^PRCA(430,BILLDA,0),"^",2)
+16 IF 'RCNOHSIF
IF PRINBAL
IF (CATEGORY=22!(CATEGORY=23))
IF '$DATA(^TMP($JOB,"RCBMILLDATA",BILLDA,TRANDA))
Begin DoDot:1
+17 SET %=$$BILLFUND^RCBMILLC(BILLDA)
End DoDot:1
+18 ;
+19 ; changed by patch PRCA*4.5*182 to no longer separate the mccf and
+20 ; hsif components. the entire amount is now reported to the ndb.
+21 ;
+22 ;. S PRINBAL=-$P($G(^TMP($J,"RCBMILLDATA",BILLDA,TRANDA)),"^",3)
+23 ;
+24 ; partial payments (trantype=2), full payments (trantype=34)
+25 ;D SETTOTAL($S(TRANTYPE=2:19,1:18),PRINBAL,0)
+26 DO SETTOTAL($SELECT(TRANTYPE=2:21,1:20),PRINBAL,0)
+27 ;I INTEREST D SETTOTAL(38,INTEREST,0)
+28 IF INTEREST
DO SETTOTAL(40,INTEREST,0)
+29 ;I ADMIN D SETTOTAL(39,ADMIN,0)
+30 IF ADMIN
DO SETTOTAL(41,ADMIN,0)
+31 ;
+32 ; irs, district counsel, dept of justice (#7)
+33 SET %=$PIECE($GET(^PRCA(433,TRANDA,0)),"^",7)
IF %=""
QUIT
+34 ;I %="IRS" D SETTOTAL(28,PRINBAL,0) Q
+35 ;PRCA*4.5*320 Increease aging buckets by 2 (on several lines below)
IF %="IRS"
DO SETTOTAL(30,PRINBAL,0)
QUIT
+36 ;I %="DC" D SETTOTAL(31,PRINBAL,0) Q
+37 IF %="DC"
DO SETTOTAL(33,PRINBAL,0)
QUIT
+38 ;I %="DOJ" D SETTOTAL(34,PRINBAL,0) Q
+39 IF %="DOJ"
DO SETTOTAL(36,PRINBAL,0)
QUIT
+40 QUIT
+41 ;
+42 ;
3 ; refer to district counsel
+1 ;D SETTOTAL(30,PRINBAL,0)
+2 DO SETTOTAL(32,PRINBAL,0)
+3 QUIT
+4 ;
+5 ;
8 ; terminate by fiscal officer
+1 ;D WRITEOFF^RCRJRCOC(BILLDA,VALUE,$S(TRANTYPE=8:25,1:24))
+2 DO WRITEOFF^RCRJRCOC(BILLDA,VALUE,$SELECT(TRANTYPE=8:27,1:26))
+3 ; decrease in number of debts
+4 ;I '$D(^TMP($J,"RCRJRCOL","COUNT",BILLDA,17)) D SETTOTAL(17,0,0)
+5 IF '$DATA(^TMP($JOB,"RCRJRCOL","COUNT",BILLDA,19))
DO SETTOTAL(19,0,0)
+6 QUIT
+7 ;
+8 ;
9 ; terminate by compromise
+1 DO 8
+2 QUIT
+3 ;
+4 ;
10 ; payment waived in full
+1 ;D WRITEOFF^RCRJRCOC(BILLDA,VALUE,22)
+2 DO WRITEOFF^RCRJRCOC(BILLDA,VALUE,24)
+3 QUIT
+4 ;
+5 ;
11 ; payment waived in partial
+1 ;D WRITEOFF^RCRJRCOC(BILLDA,VALUE,23)
+2 DO WRITEOFF^RCRJRCOC(BILLDA,VALUE,25)
+3 QUIT
+4 ;
+5 ;
12 ; admin cost / charge
+1 ; interest/admin added
+2 ;I INTEREST>0 D SETTOTAL(40,INTEREST,0)
+3 IF INTEREST>0
DO SETTOTAL(42,INTEREST,0)
+4 ;I ADMIN>0 D SETTOTAL(41,ADMIN,0)
+5 IF ADMIN>0
DO SETTOTAL(43,ADMIN,0)
+6 ; interest/admin cost exempt
+7 ;I INTEREST<0 D SETTOTAL(42,-INTEREST,0)
+8 IF INTEREST<0
DO SETTOTAL(44,-INTEREST,0)
+9 ;I ADMIN<0 D SETTOTAL(42,-ADMIN,0)
+10 IF ADMIN<0
DO SETTOTAL(44,-ADMIN,0)
+11 QUIT
+12 ;
+13 ;
13 ; interest / admin charge
+1 DO 12
+2 QUIT
+3 ;
+4 ;
14 ; exempt interest / admin cost
+1 ;D SETTOTAL(42,INTEREST,0)
+2 DO SETTOTAL(44,INTEREST,0)
+3 QUIT
+4 ;
+5 ;
34 ; payment in full
+1 DO 2
+2 ; decrease in number of debts
+3 ;I '$D(^TMP($J,"RCRJRCOL","COUNT",BILLDA,17)) D SETTOTAL(17,0,0)
+4 IF '$DATA(^TMP($JOB,"RCRJRCOL","COUNT",BILLDA,19))
DO SETTOTAL(19,0,0)
+5 QUIT
+6 ;
+7 ;
35 ; decrease adjustment
+1 NEW CONTRACT
+2 ; contractual adjustment (field #88)
+3 SET CONTRACT=$PIECE($GET(^PRCA(433,TRANDA,8)),"^",8)
+4 ;I CONTRACT D WRITEOFF^RCRJRCOC(BILLDA,VALUE,20) Q
+5 IF CONTRACT
DO WRITEOFF^RCRJRCOC(BILLDA,VALUE,22)
QUIT
+6 ;D SETTOTAL(16,PRINBAL,0)
+7 DO SETTOTAL(18,PRINBAL,0)
+8 QUIT
+9 ;
+10 ;
41 ; refund
+1 ;D SETTOTAL(43,PRINBAL,0)
+2 DO SETTOTAL(45,PRINBAL,0)
+3 QUIT
+4 ;
+5 ;
43 ; re-establishment
+1 ;D SETTOTAL(13,PRINBAL,INTEREST+ADMIN)
+2 DO SETTOTAL(15,PRINBAL,INTEREST+ADMIN)
+3 QUIT
+4 ;
+5 ;
73 ; cs increase adjustment - added with *340
+1 DO 1
+2 QUIT
+3 ;
+4 ;
74 ; cs admin.cost charge - added with *340
+1 DO 12
+2 QUIT
+3 ;
+4 ;
SETTOTAL(CRITER2,AMOUNT,INTEREST) ; store results
+1 NEW RSC,TYPE
+2 ;
+3 ; this line of code will prevent duplicate counts if a sites cross
+4 ; references in file 430 (actdt and asdt) are duplicated (incorrect)
+5 ;I CRITER2<13,$D(^TMP($J,"RCRJRCOL","COUNT",BILLDA,CRITER2)) Q
+6 IF CRITER2<15
IF $DATA(^TMP($JOB,"RCRJRCOL","COUNT",BILLDA,CRITER2))
QUIT
+7 ;
+8 ; get a bills criteria 1,3,4,5
+9 SET CRITERIA=$GET(^TMP($JOB,"RCRJRCOL","CRITERIA",BILLDA))
+10 IF CRITERIA=""
SET CRITERIA=$$CRITERIA^RCRJRCOL(BILLDA)
SET ^TMP($JOB,"RCRJRCOL","CRITERIA",BILLDA)=CRITERIA
+11 ;
+12 ; store for ndb
+13 SET $PIECE(CRITERIA,"-",2)=CRITER2
+14 ;
+15 ; store results for ndb
+16 SET %=$GET(@DATASTOR)
+17 SET $PIECE(%,"^")=$PIECE(%,"^")+1
+18 SET $PIECE(%,"^",2)=$PIECE(%,"^",2)+AMOUNT
+19 SET $PIECE(%,"^",3)=$PIECE(%,"^",3)+INTEREST
+20 SET @DATASTOR=%
+21 ;
+22 ; keep a count of which category (criter2) a bill is counted in
+23 SET ^TMP($JOB,"RCRJRCOL","COUNT",BILLDA,CRITER2)=""
+24 SET ^TMP($JOB,"RCRJRCOL","CRIT2",CRITER2,BILLDA)=""
+25 ;
+26 ; pick up bills with activity which may not have been picked up as
+27 ; a current receivable because of the wrong status date
+28 ;I CRITER2>13,CRITER2'=17,'$D(^TMP($J,"RCRJRCOL","COUNT",BILLDA,1)),'$D(^TMP($J,"RCRJRCOL","COUNT",BILLDA,17)) D CURRENT^RCRJRCOB(BILLDA,DATEEND,AYEAROLD)
+29 IF CRITER2>15
IF CRITER2'=19
IF '$DATA(^TMP($JOB,"RCRJRCOL","COUNT",BILLDA,1))
IF '$DATA(^TMP($JOB,"RCRJRCOL","COUNT",BILLDA,19))
DO CURRENT^RCRJRCOB(BILLDA,DATEEND,AYEAROLD)
+30 QUIT
