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

RCBMILLT.m

Go to the documentation of this file.
  1. RCBMILLT ;WISC/RFJ-millennium bill (get TR data) ;1 Oct 01
  1. ;;4.5;Accounts Receivable;**170**;Mar 20, 1995
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. Q
  1. ;
  1. ;
  1. GETPAY(RCDATEND) ; get payments for the month
  1. ; returns rctrans(fromfund,fromrsc) = tofund ^ torsc ^ amount to transfer
  1. ; fromfund is 5287 and tofund is 5358.1
  1. ;
  1. N DATA,RCBILLDA,RCRSC,RCTOTAL,RCTRANDA,TORCRSC
  1. ;
  1. S RCBILLDA=0 F S RCBILLDA=$O(^TMP($J,"RCBMILLDATA",RCBILLDA)) Q:'RCBILLDA D
  1. . ; get the rsc for the bill
  1. . S RCRSC=$$CALCRSC^RCXFMSUR(RCBILLDA)
  1. . ;
  1. . S RCTRANDA=0 F S RCTRANDA=$O(^TMP($J,"RCBMILLDATA",RCBILLDA,RCTRANDA)) Q:'RCTRANDA D
  1. . . ;
  1. . . ; data piece 1 = type of transaction (1 letter)
  1. . . ; data piece 2 = principal amt of transaction
  1. . . ; data piece 3 = amount owed to mccf
  1. . . ; data piece 4 = amount owed to hsif
  1. . . ; data piece 5 = for payment, amount already paid to mccf
  1. . . ; data piece 6 = for payment, amount already paid to hsif
  1. . . S DATA=^TMP($J,"RCBMILLDATA",RCBILLDA,RCTRANDA)
  1. . . ;
  1. . . ; only count payments
  1. . . I $E(DATA)'="P" Q
  1. . . ;
  1. . . ; only report the transfer if the payment was during the
  1. . . ; current month
  1. . . I +$E($P($G(^PRCA(433,RCTRANDA,1)),"^",9),1,5)'=+$E(RCDATEND,1,5) Q
  1. . . ;
  1. . . ; total the amount to transfer to hsif
  1. . . ; (payment value is stored as a minus)
  1. . . S RCTOTAL(RCRSC)=$G(RCTOTAL(RCRSC))-$P(DATA,"^",4)
  1. ;
  1. ; put dollars in rctrans(fromfund,fromrsc) = tofund ^ torsc ^ amount
  1. K RCTRANS
  1. S RCRSC="" F S RCRSC=$O(RCTOTAL(RCRSC)) Q:RCRSC="" D
  1. . ; if the rsc for the bill is 8BZZ, transfer to 8B1Z
  1. . ; if the rsc for the bill is 8CZZ, transfer to 8C1Z
  1. . I RCRSC="8BZZ" S TORCRSC="8B1Z"
  1. . I RCRSC="8CZZ" S TORCRSC="8C1Z"
  1. . I RCTOTAL(RCRSC) S RCTRANS(5287,RCRSC)="5358.1^"_TORCRSC_"^"_RCTOTAL(RCRSC)
  1. Q
  1. ;
  1. ;
  1. SETPAY(RCDATEND) ; set payments for the month
  1. ; this call will set the 433 transaction showing the dollars
  1. ; transferred to hsif on the payment (fields 91 and 92)
  1. ;
  1. N DATA,RCBILLDA,RCTRANDA
  1. ;
  1. S RCBILLDA=0 F S RCBILLDA=$O(^TMP($J,"RCBMILLDATA",RCBILLDA)) Q:'RCBILLDA D
  1. . ;
  1. . S RCTRANDA=0 F S RCTRANDA=$O(^TMP($J,"RCBMILLDATA",RCBILLDA,RCTRANDA)) Q:'RCTRANDA D
  1. . . ;
  1. . . ; data piece 1 = type of transaction (1 letter)
  1. . . ; data piece 2 = principal amt of transaction
  1. . . ; data piece 3 = amount owed to mccf
  1. . . ; data piece 4 = amount owed to hsif
  1. . . ; data piece 5 = for payment, amount already paid to mccf
  1. . . ; data piece 6 = for payment, amount already paid to hsif
  1. . . S DATA=^TMP($J,"RCBMILLDATA",RCBILLDA,RCTRANDA)
  1. . . ;
  1. . . ; only count payments
  1. . . I $E(DATA)'="P" Q
  1. . . ;
  1. . . ; only report the transfer if the payment was during the
  1. . . ; current month
  1. . . I +$E($P($G(^PRCA(433,RCTRANDA,1)),"^",9),1,5)'=+$E(RCDATEND,1,5) Q
  1. . . ;
  1. . . ; set as paid
  1. . . S $P(^PRCA(433,RCTRANDA,9),"^",1,2)=(-$P(DATA,"^",3))_"^"_(-$P(DATA,"^",4))
  1. Q