- 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 Feb 18, 2025@23:09:28 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