Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCRJRCO1

RCRJRCO1.m

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