source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCBMILL4.m@ 1579

Last change on this file since 1579 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.9 KB
Line 
1RCBMILL4 ;WISC/RFJ-millennium bill report (print history for date range) ; 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 ;
7PRINT ; print history for date range
8 N DATA,DATA1,GECSDATA,RCAMOUNT,RCBILLDA,RCDATE,RCLINE,RCTOTAL,RCTRANDA,TYPE,Y
9 ;
10 ; intialize totals for month
11 K ^TMP("RCBMILL4",$J)
12 ;
13 ; loop the bills with payments
14 S RCBILLDA=0 F S RCBILLDA=$O(^TMP($J,"RCBMILLDATA",RCBILLDA)) Q:'RCBILLDA D
15 . ;
16 . ; loop the transactions
17 . S RCTRANDA=0 F S RCTRANDA=$O(^TMP($J,"RCBMILLDATA",RCBILLDA,RCTRANDA)) Q:'RCTRANDA D
18 . . ;
19 . . ; get the type of transaction
20 . . S DATA1=$G(^PRCA(433,RCTRANDA,1))
21 . . S TYPE=$P(DATA1,"^",2)
22 . . ;
23 . . ; only print payments for the selected date range
24 . . I $P(DATA1,"^",9)<RCDATBEG!($P(DATA1,"^",9)>RCDATEND) Q
25 . . ;
26 . . ; if not a payment, quit
27 . . I TYPE'=2,TYPE'=34 Q
28 . . ; data = principal amt of transaction
29 . . ; amount owed to mccf
30 . . ; amount owed to hsif
31 . . ; for payment, amount paid to mccf
32 . . ; for payment, amount paid to hsif
33 . . S DATA=^TMP($J,"RCBMILLDATA",RCBILLDA,RCTRANDA)
34 . . ;
35 . . ; compute totals paid for selected report month
36 . . ; payment dollars are recorded in data as minus
37 . . S ^TMP("RCBMILL4",$J,$E($P(DATA1,"^",9),1,5),"TO MCCF")=$G(^TMP("RCBMILL4",$J,$E($P(DATA1,"^",9),1,5),"TO MCCF"))-$P(DATA,"^",3)
38 . . S ^TMP("RCBMILL4",$J,$E($P(DATA1,"^",9),1,5),"TO HSIF")=$G(^TMP("RCBMILL4",$J,$E($P(DATA1,"^",9),1,5),"TO HSIF"))-$P(DATA,"^",4)
39 . . S ^TMP("RCBMILL4",$J,$E($P(DATA1,"^",9),1,5),"PAID TO HSIF")=$G(^TMP("RCBMILL4",$J,$E($P(DATA1,"^",9),1,5),"PAID TO HSIF"))+$P(DATA,"^",6)
40 ;
41 U IO D H
42 ;
43 S RCDATE="" F S RCDATE=$O(^TMP("RCBMILL4",$J,RCDATE)) Q:'RCDATE!($G(RCRJFLAG)) D
44 . ; page break
45 . I $Y>(IOSL-4) D:RCSCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H
46 . ;
47 . S Y=$E(RCDATE,1,5)_"00" D DD^%DT
48 . ; write month/year and split amount paid to mccf
49 . W !,Y,?10," |",$J($G(^TMP("RCBMILL4",$J,RCDATE,"TO MCCF")),12,2)," |"
50 . ; write split amount paid to hsif
51 . W $J($G(^TMP("RCBMILL4",$J,RCDATE,"TO HSIF")),12,2)
52 . ; write amount paid to hsif
53 . W $J($G(^TMP("RCBMILL4",$J,RCDATE,"PAID TO HSIF")),12,2)
54 . ; write amount owed to hsif
55 . W $J($G(^TMP("RCBMILL4",$J,RCDATE,"TO HSIF"))-$G(^TMP("RCBMILL4",$J,RCDATE,"PAID TO HSIF")),12,2)," |"
56 . ;
57 . ; get the code sheet data
58 . K GECSDATA
59 . D KEYLOOK^GECSSGET("TR-"_$E(RCDATE,1,5)_"00",1)
60 . ;
61 . S RCAMOUNT=0
62 . I $G(GECSDATA) D
63 . . S RCLINE=0 F S RCLINE=$O(GECSDATA(2100.1,GECSDATA,10,RCLINE)) Q:'RCLINE D
64 . . . S DATA=GECSDATA(2100.1,GECSDATA,10,RCLINE)
65 . . . I $P(DATA,"^")'="LIN" Q
66 . . . I $P(DATA,"^",6)'="5358.1" Q
67 . . . I $P(DATA,"^",21)'="I" Q
68 . . . S RCAMOUNT=RCAMOUNT+$P(DATA,"^",20)
69 . ;
70 . W $J(RCAMOUNT,12,2)
71 . ;
72 . ; total all columns
73 . S RCTOTAL(1)=$G(RCTOTAL(1))+$G(^TMP("RCBMILL4",$J,RCDATE,"TO MCCF"))
74 . S RCTOTAL(2)=$G(RCTOTAL(2))+$G(^TMP("RCBMILL4",$J,RCDATE,"TO HSIF"))
75 . S RCTOTAL(3)=$G(RCTOTAL(3))+$G(^TMP("RCBMILL4",$J,RCDATE,"PAID TO HSIF"))
76 . S RCTOTAL(5)=$G(RCTOTAL(5))+RCAMOUNT
77 ;
78 ; page break
79 I $G(RCRJFLAG) D Q Q
80 I $Y>(IOSL-5) D:RCSCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H
81 ;
82 ; show totals
83 W !,"==============================================================================="
84 W !,"TOTALS",?10," |",$J($G(RCTOTAL(1)),12,2)," |",$J($G(RCTOTAL(2)),12,2),$J($G(RCTOTAL(3)),12,2),$J($G(RCTOTAL(2))-$G(RCTOTAL(3)),12,2)," |",$J($G(RCTOTAL(5)),12,2)
85 W !,"==============================================================================="
86 ;
87 ; page break
88 I $G(RCRJFLAG) D Q Q
89 I $Y>(IOSL-8) D:RCSCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H
90 ;
91 ; show what columns mean
92 W !,"Column 2 is the dollar amount of RX-Copayments that is split to MCCF."
93 W !,"Column 3 is the dollar amount of RX-Copayments that is split to HSIF."
94 W !,"Column 4 is the dollar amount of HSIF payments that is paid to HSIF in FMS."
95 W !,"Column 5 is the dollar difference between columns 3 and 4. This is the amount"
96 W !," owed (needs to be transferred from MCCF) to HSIF."
97 W !,"Column 6 is the dollar amount transferred from MCCF to HSIF taken from the"
98 W !," monthly (TR)ansfer document."
99 ;
100Q ; quit report
101 K ^TMP("RCBMILL4",$J)
102 Q
103 ;
104 ;
105H ; print heading
106 S %=RCNOW_" PAGE "_RCPAGE,RCPAGE=RCPAGE+1 I RCPAGE'=2!(RCSCREEN) W @IOF
107 W $C(13),"PAYMENTS SPLIT TO HSIF/MCCF HISTORY REPORT",?(79-$L(%)),%
108 ;
109 W !," FROM MONTH/YEAR: ",RCMOYR," TO MONTH/YEAR: ",RCMOYRTO
110 W !,?10," |",$J("PAYMENTS",12)," |",$J("PAYMENTS",12),$J("PAID TO",12),$J("OWED TO",12)," |",$J("DOCUMENT",12)
111 W !,"MONTH/YEAR",?10," |",$J("TO MCCF",12)," |",$J("TO HSIF",12),$J("HSIF",12),$J("HSIF",12)," |",$J("AMT TO HSIF",12)
112 W !,"-------------------------------------------------------------------------------"
113 Q
Note: See TracBrowser for help on using the repository browser.