RCBMILLT ;WISC/RFJ-millennium bill (get TR data) ;1 Oct 01
;;4.5;Accounts Receivable;**170**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
GETPAY(RCDATEND) ; get payments for the month
; returns rctrans(fromfund,fromrsc) = tofund ^ torsc ^ amount to transfer
; fromfund is 5287 and tofund is 5358.1
;
N DATA,RCBILLDA,RCRSC,RCTOTAL,RCTRANDA,TORCRSC
;
S RCBILLDA=0 F S RCBILLDA=$O(^TMP($J,"RCBMILLDATA",RCBILLDA)) Q:'RCBILLDA D
. ; get the rsc for the bill
. S RCRSC=$$CALCRSC^RCXFMSUR(RCBILLDA)
. ;
. S RCTRANDA=0 F S RCTRANDA=$O(^TMP($J,"RCBMILLDATA",RCBILLDA,RCTRANDA)) Q:'RCTRANDA D
. . ;
. . ; data piece 1 = type of transaction (1 letter)
. . ; data piece 2 = principal amt of transaction
. . ; data piece 3 = amount owed to mccf
. . ; data piece 4 = amount owed to hsif
. . ; data piece 5 = for payment, amount already paid to mccf
. . ; data piece 6 = for payment, amount already paid to hsif
. . S DATA=^TMP($J,"RCBMILLDATA",RCBILLDA,RCTRANDA)
. . ;
. . ; only count payments
. . I $E(DATA)'="P" Q
. . ;
. . ; only report the transfer if the payment was during the
. . ; current month
. . I +$E($P($G(^PRCA(433,RCTRANDA,1)),"^",9),1,5)'=+$E(RCDATEND,1,5) Q
. . ;
. . ; total the amount to transfer to hsif
. . ; (payment value is stored as a minus)
. . S RCTOTAL(RCRSC)=$G(RCTOTAL(RCRSC))-$P(DATA,"^",4)
;
; put dollars in rctrans(fromfund,fromrsc) = tofund ^ torsc ^ amount
K RCTRANS
S RCRSC="" F S RCRSC=$O(RCTOTAL(RCRSC)) Q:RCRSC="" D
. ; if the rsc for the bill is 8BZZ, transfer to 8B1Z
. ; if the rsc for the bill is 8CZZ, transfer to 8C1Z
. I RCRSC="8BZZ" S TORCRSC="8B1Z"
. I RCRSC="8CZZ" S TORCRSC="8C1Z"
. I RCTOTAL(RCRSC) S RCTRANS(5287,RCRSC)="5358.1^"_TORCRSC_"^"_RCTOTAL(RCRSC)
Q
;
;
SETPAY(RCDATEND) ; set payments for the month
; this call will set the 433 transaction showing the dollars
; transferred to hsif on the payment (fields 91 and 92)
;
N DATA,RCBILLDA,RCTRANDA
;
S RCBILLDA=0 F S RCBILLDA=$O(^TMP($J,"RCBMILLDATA",RCBILLDA)) Q:'RCBILLDA D
. ;
. S RCTRANDA=0 F S RCTRANDA=$O(^TMP($J,"RCBMILLDATA",RCBILLDA,RCTRANDA)) Q:'RCTRANDA D
. . ;
. . ; data piece 1 = type of transaction (1 letter)
. . ; data piece 2 = principal amt of transaction
. . ; data piece 3 = amount owed to mccf
. . ; data piece 4 = amount owed to hsif
. . ; data piece 5 = for payment, amount already paid to mccf
. . ; data piece 6 = for payment, amount already paid to hsif
. . S DATA=^TMP($J,"RCBMILLDATA",RCBILLDA,RCTRANDA)
. . ;
. . ; only count payments
. . I $E(DATA)'="P" Q
. . ;
. . ; only report the transfer if the payment was during the
. . ; current month
. . I +$E($P($G(^PRCA(433,RCTRANDA,1)),"^",9),1,5)'=+$E(RCDATEND,1,5) Q
. . ;
. . ; set as paid
. . S $P(^PRCA(433,RCTRANDA,9),"^",1,2)=(-$P(DATA,"^",3))_"^"_(-$P(DATA,"^",4))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCBMILLT 3150 printed Sep 23, 2025@19:19:06 Page 2
RCBMILLT ;WISC/RFJ-millennium bill (get TR data) ;1 Oct 01
+1 ;;4.5;Accounts Receivable;**170**;Mar 20, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
GETPAY(RCDATEND) ; get payments for the month
+1 ; returns rctrans(fromfund,fromrsc) = tofund ^ torsc ^ amount to transfer
+2 ; fromfund is 5287 and tofund is 5358.1
+3 ;
+4 NEW DATA,RCBILLDA,RCRSC,RCTOTAL,RCTRANDA,TORCRSC
+5 ;
+6 SET RCBILLDA=0
FOR
SET RCBILLDA=$ORDER(^TMP($JOB,"RCBMILLDATA",RCBILLDA))
if 'RCBILLDA
QUIT
Begin DoDot:1
+7 ; get the rsc for the bill
+8 SET RCRSC=$$CALCRSC^RCXFMSUR(RCBILLDA)
+9 ;
+10 SET RCTRANDA=0
FOR
SET RCTRANDA=$ORDER(^TMP($JOB,"RCBMILLDATA",RCBILLDA,RCTRANDA))
if 'RCTRANDA
QUIT
Begin DoDot:2
+11 ;
+12 ; data piece 1 = type of transaction (1 letter)
+13 ; data piece 2 = principal amt of transaction
+14 ; data piece 3 = amount owed to mccf
+15 ; data piece 4 = amount owed to hsif
+16 ; data piece 5 = for payment, amount already paid to mccf
+17 ; data piece 6 = for payment, amount already paid to hsif
+18 SET DATA=^TMP($JOB,"RCBMILLDATA",RCBILLDA,RCTRANDA)
+19 ;
+20 ; only count payments
+21 IF $EXTRACT(DATA)'="P"
QUIT
+22 ;
+23 ; only report the transfer if the payment was during the
+24 ; current month
+25 IF +$EXTRACT($PIECE($GET(^PRCA(433,RCTRANDA,1)),"^",9),1,5)'=+$EXTRACT(RCDATEND,1,5)
QUIT
+26 ;
+27 ; total the amount to transfer to hsif
+28 ; (payment value is stored as a minus)
+29 SET RCTOTAL(RCRSC)=$GET(RCTOTAL(RCRSC))-$PIECE(DATA,"^",4)
End DoDot:2
End DoDot:1
+30 ;
+31 ; put dollars in rctrans(fromfund,fromrsc) = tofund ^ torsc ^ amount
+32 KILL RCTRANS
+33 SET RCRSC=""
FOR
SET RCRSC=$ORDER(RCTOTAL(RCRSC))
if RCRSC=""
QUIT
Begin DoDot:1
+34 ; if the rsc for the bill is 8BZZ, transfer to 8B1Z
+35 ; if the rsc for the bill is 8CZZ, transfer to 8C1Z
+36 IF RCRSC="8BZZ"
SET TORCRSC="8B1Z"
+37 IF RCRSC="8CZZ"
SET TORCRSC="8C1Z"
+38 IF RCTOTAL(RCRSC)
SET RCTRANS(5287,RCRSC)="5358.1^"_TORCRSC_"^"_RCTOTAL(RCRSC)
End DoDot:1
+39 QUIT
+40 ;
+41 ;
SETPAY(RCDATEND) ; set payments for the month
+1 ; this call will set the 433 transaction showing the dollars
+2 ; transferred to hsif on the payment (fields 91 and 92)
+3 ;
+4 NEW DATA,RCBILLDA,RCTRANDA
+5 ;
+6 SET RCBILLDA=0
FOR
SET RCBILLDA=$ORDER(^TMP($JOB,"RCBMILLDATA",RCBILLDA))
if 'RCBILLDA
QUIT
Begin DoDot:1
+7 ;
+8 SET RCTRANDA=0
FOR
SET RCTRANDA=$ORDER(^TMP($JOB,"RCBMILLDATA",RCBILLDA,RCTRANDA))
if 'RCTRANDA
QUIT
Begin DoDot:2
+9 ;
+10 ; data piece 1 = type of transaction (1 letter)
+11 ; data piece 2 = principal amt of transaction
+12 ; data piece 3 = amount owed to mccf
+13 ; data piece 4 = amount owed to hsif
+14 ; data piece 5 = for payment, amount already paid to mccf
+15 ; data piece 6 = for payment, amount already paid to hsif
+16 SET DATA=^TMP($JOB,"RCBMILLDATA",RCBILLDA,RCTRANDA)
+17 ;
+18 ; only count payments
+19 IF $EXTRACT(DATA)'="P"
QUIT
+20 ;
+21 ; only report the transfer if the payment was during the
+22 ; current month
+23 IF +$EXTRACT($PIECE($GET(^PRCA(433,RCTRANDA,1)),"^",9),1,5)'=+$EXTRACT(RCDATEND,1,5)
QUIT
+24 ;
+25 ; set as paid
+26 SET $PIECE(^PRCA(433,RCTRANDA,9),"^",1,2)=(-$PIECE(DATA,"^",3))_"^"_(-$PIECE(DATA,"^",4))
End DoDot:2
End DoDot:1
+27 QUIT
