| 1 | RCBMILL3 ;WISC/RFJ-millennium bill report (summary) ; 27 Jun 2001 11:10 AM
|
|---|
| 2 | ;;4.5;Accounts Receivable;**170**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | SUMMARY ; print summary
|
|---|
| 8 | N DATA,DATA1,RCBILLDA,RCTOTALM,RCTRANDA,TYPE
|
|---|
| 9 | ;
|
|---|
| 10 | U IO D H
|
|---|
| 11 | ;
|
|---|
| 12 | ; intialize totals for month
|
|---|
| 13 | S RCTOTALM("TO MCCF")=0
|
|---|
| 14 | S RCTOTALM("TO HSIF")=0
|
|---|
| 15 | S RCTOTALM("PAID TO HSIF")=0
|
|---|
| 16 | ;
|
|---|
| 17 | ; loop the bills with payments
|
|---|
| 18 | S RCBILLDA=0 F S RCBILLDA=$O(^TMP($J,"RCBMILLDATA",RCBILLDA)) Q:'RCBILLDA D
|
|---|
| 19 | . ;
|
|---|
| 20 | . ; loop the transactions
|
|---|
| 21 | . S RCTRANDA=0 F S RCTRANDA=$O(^TMP($J,"RCBMILLDATA",RCBILLDA,RCTRANDA)) Q:'RCTRANDA D
|
|---|
| 22 | . . ;
|
|---|
| 23 | . . ; get the type of transaction
|
|---|
| 24 | . . S DATA1=$G(^PRCA(433,RCTRANDA,1))
|
|---|
| 25 | . . S TYPE=$P(DATA1,"^",2)
|
|---|
| 26 | . . ;
|
|---|
| 27 | . . ; only print payments for the selected month
|
|---|
| 28 | . . I $E($P(DATA1,"^",9),1,5)'=$E(RCDATBEG,1,5) Q
|
|---|
| 29 | . . ;
|
|---|
| 30 | . . ; if not a payment, quit
|
|---|
| 31 | . . I TYPE'=2,TYPE'=34 Q
|
|---|
| 32 | . . ; data = principal amt of transaction
|
|---|
| 33 | . . ; amount owed to mccf
|
|---|
| 34 | . . ; amount owed to hsif
|
|---|
| 35 | . . ; for payment, amount paid to mccf
|
|---|
| 36 | . . ; for payment, amount paid to hsif
|
|---|
| 37 | . . S DATA=^TMP($J,"RCBMILLDATA",RCBILLDA,RCTRANDA)
|
|---|
| 38 | . . ;
|
|---|
| 39 | . . ; compute totals paid for selected report month
|
|---|
| 40 | . . ; payment dollars are recorded in data as minus
|
|---|
| 41 | . . S RCTOTALM("TO MCCF")=RCTOTALM("TO MCCF")-$P(DATA,"^",3)
|
|---|
| 42 | . . S RCTOTALM("TO HSIF")=RCTOTALM("TO HSIF")-$P(DATA,"^",4)
|
|---|
| 43 | . . S RCTOTALM("PAID TO HSIF")=RCTOTALM("PAID TO HSIF")+$P(DATA,"^",6)
|
|---|
| 44 | ;
|
|---|
| 45 | D TOTALS^RCBMILL2
|
|---|
| 46 | ;
|
|---|
| 47 | ; lookup data in generic code sheets (pass key and 1 for code sheet)
|
|---|
| 48 | N GECSDATA,RCLINE
|
|---|
| 49 | D KEYLOOK^GECSSGET("TR-"_RCDATBEG,1)
|
|---|
| 50 | ;
|
|---|
| 51 | W !!,"TRANSFER DOCUMENT DATA:"
|
|---|
| 52 | W !,"-----------------------"
|
|---|
| 53 | I '$G(GECSDATA) W !?5,"Transfer (TR) Document NOT Created for ",RCMOYR
|
|---|
| 54 | I $G(GECSDATA) D
|
|---|
| 55 | . W !,"Generic Code Sheet Id: ",$G(GECSDATA(2100.1,GECSDATA,.01,"E"))
|
|---|
| 56 | . W !," Description: ",$G(GECSDATA(2100.1,GECSDATA,4,"E"))
|
|---|
| 57 | . W !," Date/Time Created: ",$G(GECSDATA(2100.1,GECSDATA,2,"E"))
|
|---|
| 58 | . W !," Status: ",$G(GECSDATA(2100.1,GECSDATA,3,"E"))
|
|---|
| 59 | . ;
|
|---|
| 60 | . ; page break
|
|---|
| 61 | . I $Y>(IOSL-5),$O(GECSDATA(2100.1,GECSDATA,10,0)) D:RCSCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H
|
|---|
| 62 | . W !?6,"Actual Document: "
|
|---|
| 63 | . F RCLINE=1:1 Q:'$D(GECSDATA(2100.1,GECSDATA,10,RCLINE))!($G(RCRJFLAG)) D
|
|---|
| 64 | . . W !,GECSDATA(2100.1,GECSDATA,10,RCLINE)
|
|---|
| 65 | . . I $Y>(IOSL-5),$O(GECSDATA(2100.1,GECSDATA,10,RCLINE)) D:RCSCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H W !?5," Actual Document: <continued>"
|
|---|
| 66 | Q
|
|---|
| 67 | ;
|
|---|
| 68 | ;
|
|---|
| 69 | H ; print heading
|
|---|
| 70 | S %=RCNOW_" PAGE "_RCPAGE,RCPAGE=RCPAGE+1 I RCPAGE'=2!(RCSCREEN) W @IOF
|
|---|
| 71 | W $C(13),"PAYMENTS SPLIT TO HSIF/MCCF SUMMARY REPORT",?(79-$L(%)),%
|
|---|
| 72 | ;
|
|---|
| 73 | W !," FOR THE MONTH/YEAR: ",RCMOYR
|
|---|
| 74 | W !!,"* * * S U M M A R Y P A G E * * *"
|
|---|
| 75 | W !,"-------------------------------------------------------------------------------"
|
|---|
| 76 | Q
|
|---|
