RCBMILL4 ;WISC/RFJ-millennium bill report (print history for date range) ; 27 Jun 2001 11:10 AM
;;4.5;Accounts Receivable;**170**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
PRINT ; print history for date range
N DATA,DATA1,GECSDATA,RCAMOUNT,RCBILLDA,RCDATE,RCLINE,RCTOTAL,RCTRANDA,TYPE,Y
;
; intialize totals for month
K ^TMP("RCBMILL4",$J)
;
; loop the bills with payments
S RCBILLDA=0 F S RCBILLDA=$O(^TMP($J,"RCBMILLDATA",RCBILLDA)) Q:'RCBILLDA D
. ;
. ; loop the transactions
. S RCTRANDA=0 F S RCTRANDA=$O(^TMP($J,"RCBMILLDATA",RCBILLDA,RCTRANDA)) Q:'RCTRANDA D
. . ;
. . ; get the type of transaction
. . S DATA1=$G(^PRCA(433,RCTRANDA,1))
. . S TYPE=$P(DATA1,"^",2)
. . ;
. . ; only print payments for the selected date range
. . I $P(DATA1,"^",9)<RCDATBEG!($P(DATA1,"^",9)>RCDATEND) Q
. . ;
. . ; if not a payment, quit
. . I TYPE'=2,TYPE'=34 Q
. . ; data = principal amt of transaction
. . ; amount owed to mccf
. . ; amount owed to hsif
. . ; for payment, amount paid to mccf
. . ; for payment, amount paid to hsif
. . S DATA=^TMP($J,"RCBMILLDATA",RCBILLDA,RCTRANDA)
. . ;
. . ; compute totals paid for selected report month
. . ; payment dollars are recorded in data as minus
. . 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)
. . 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)
. . 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)
;
U IO D H
;
S RCDATE="" F S RCDATE=$O(^TMP("RCBMILL4",$J,RCDATE)) Q:'RCDATE!($G(RCRJFLAG)) D
. ; page break
. I $Y>(IOSL-4) D:RCSCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H
. ;
. S Y=$E(RCDATE,1,5)_"00" D DD^%DT
. ; write month/year and split amount paid to mccf
. W !,Y,?10," |",$J($G(^TMP("RCBMILL4",$J,RCDATE,"TO MCCF")),12,2)," |"
. ; write split amount paid to hsif
. W $J($G(^TMP("RCBMILL4",$J,RCDATE,"TO HSIF")),12,2)
. ; write amount paid to hsif
. W $J($G(^TMP("RCBMILL4",$J,RCDATE,"PAID TO HSIF")),12,2)
. ; write amount owed to hsif
. W $J($G(^TMP("RCBMILL4",$J,RCDATE,"TO HSIF"))-$G(^TMP("RCBMILL4",$J,RCDATE,"PAID TO HSIF")),12,2)," |"
. ;
. ; get the code sheet data
. K GECSDATA
. D KEYLOOK^GECSSGET("TR-"_$E(RCDATE,1,5)_"00",1)
. ;
. S RCAMOUNT=0
. I $G(GECSDATA) D
. . S RCLINE=0 F S RCLINE=$O(GECSDATA(2100.1,GECSDATA,10,RCLINE)) Q:'RCLINE D
. . . S DATA=GECSDATA(2100.1,GECSDATA,10,RCLINE)
. . . I $P(DATA,"^")'="LIN" Q
. . . I $P(DATA,"^",6)'="5358.1" Q
. . . I $P(DATA,"^",21)'="I" Q
. . . S RCAMOUNT=RCAMOUNT+$P(DATA,"^",20)
. ;
. W $J(RCAMOUNT,12,2)
. ;
. ; total all columns
. S RCTOTAL(1)=$G(RCTOTAL(1))+$G(^TMP("RCBMILL4",$J,RCDATE,"TO MCCF"))
. S RCTOTAL(2)=$G(RCTOTAL(2))+$G(^TMP("RCBMILL4",$J,RCDATE,"TO HSIF"))
. S RCTOTAL(3)=$G(RCTOTAL(3))+$G(^TMP("RCBMILL4",$J,RCDATE,"PAID TO HSIF"))
. S RCTOTAL(5)=$G(RCTOTAL(5))+RCAMOUNT
;
; page break
I $G(RCRJFLAG) D Q Q
I $Y>(IOSL-5) D:RCSCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H
;
; show totals
W !,"==============================================================================="
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)
W !,"==============================================================================="
;
; page break
I $G(RCRJFLAG) D Q Q
I $Y>(IOSL-8) D:RCSCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H
;
; show what columns mean
W !,"Column 2 is the dollar amount of RX-Copayments that is split to MCCF."
W !,"Column 3 is the dollar amount of RX-Copayments that is split to HSIF."
W !,"Column 4 is the dollar amount of HSIF payments that is paid to HSIF in FMS."
W !,"Column 5 is the dollar difference between columns 3 and 4. This is the amount"
W !," owed (needs to be transferred from MCCF) to HSIF."
W !,"Column 6 is the dollar amount transferred from MCCF to HSIF taken from the"
W !," monthly (TR)ansfer document."
;
Q ; quit report
K ^TMP("RCBMILL4",$J)
Q
;
;
H ; print heading
S %=RCNOW_" PAGE "_RCPAGE,RCPAGE=RCPAGE+1 I RCPAGE'=2!(RCSCREEN) W @IOF
W $C(13),"PAYMENTS SPLIT TO HSIF/MCCF HISTORY REPORT",?(79-$L(%)),%
;
W !," FROM MONTH/YEAR: ",RCMOYR," TO MONTH/YEAR: ",RCMOYRTO
W !,?10," |",$J("PAYMENTS",12)," |",$J("PAYMENTS",12),$J("PAID TO",12),$J("OWED TO",12)," |",$J("DOCUMENT",12)
W !,"MONTH/YEAR",?10," |",$J("TO MCCF",12)," |",$J("TO HSIF",12),$J("HSIF",12),$J("HSIF",12)," |",$J("AMT TO HSIF",12)
W !,"-------------------------------------------------------------------------------"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCBMILL4 5142 printed Apr 09, 2024@20:52:57 Page 2
RCBMILL4 ;WISC/RFJ-millennium bill report (print history for date range) ; 27 Jun 2001 11:10 AM
+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 ;
PRINT ; print history for date range
+1 NEW DATA,DATA1,GECSDATA,RCAMOUNT,RCBILLDA,RCDATE,RCLINE,RCTOTAL,RCTRANDA,TYPE,Y
+2 ;
+3 ; intialize totals for month
+4 KILL ^TMP("RCBMILL4",$JOB)
+5 ;
+6 ; loop the bills with payments
+7 SET RCBILLDA=0
FOR
SET RCBILLDA=$ORDER(^TMP($JOB,"RCBMILLDATA",RCBILLDA))
if 'RCBILLDA
QUIT
Begin DoDot:1
+8 ;
+9 ; loop the transactions
+10 SET RCTRANDA=0
FOR
SET RCTRANDA=$ORDER(^TMP($JOB,"RCBMILLDATA",RCBILLDA,RCTRANDA))
if 'RCTRANDA
QUIT
Begin DoDot:2
+11 ;
+12 ; get the type of transaction
+13 SET DATA1=$GET(^PRCA(433,RCTRANDA,1))
+14 SET TYPE=$PIECE(DATA1,"^",2)
+15 ;
+16 ; only print payments for the selected date range
+17 IF $PIECE(DATA1,"^",9)<RCDATBEG!($PIECE(DATA1,"^",9)>RCDATEND)
QUIT
+18 ;
+19 ; if not a payment, quit
+20 IF TYPE'=2
IF TYPE'=34
QUIT
+21 ; data = principal amt of transaction
+22 ; amount owed to mccf
+23 ; amount owed to hsif
+24 ; for payment, amount paid to mccf
+25 ; for payment, amount paid to hsif
+26 SET DATA=^TMP($JOB,"RCBMILLDATA",RCBILLDA,RCTRANDA)
+27 ;
+28 ; compute totals paid for selected report month
+29 ; payment dollars are recorded in data as minus
+30 SET ^TMP("RCBMILL4",$JOB,$EXTRACT($PIECE(DATA1,"^",9),1,5),"TO MCCF")=$GET(^TMP("RCBMILL4",$JOB,$EXTRACT($PIECE(DATA1,"^",9),1,5),"TO MCCF"))-$PIECE(DATA,"^",3)
+31 SET ^TMP("RCBMILL4",$JOB,$EXTRACT($PIECE(DATA1,"^",9),1,5),"TO HSIF")=$GET(^TMP("RCBMILL4",$JOB,$EXTRACT($PIECE(DATA1,"^",9),1,5),"TO HSIF"))-$PIECE(DATA,"^",4)
+32 SET ^TMP("RCBMILL4",$JOB,$EXTRACT($PIECE(DATA1,"^",9),1,5),"PAID TO HSIF")=$GET(^TMP("RCBMILL4",$JOB,$EXTRACT($PIECE(DATA1,"^",9),1,5),"PAID TO HSIF"))+$PIECE(DATA,"^",6)
End DoDot:2
End DoDot:1
+33 ;
+34 USE IO
DO H
+35 ;
+36 SET RCDATE=""
FOR
SET RCDATE=$ORDER(^TMP("RCBMILL4",$JOB,RCDATE))
if 'RCDATE!($GET(RCRJFLAG))
QUIT
Begin DoDot:1
+37 ; page break
+38 IF $Y>(IOSL-4)
if RCSCREEN
DO PAUSE^RCRJRTR1
if $GET(RCRJFLAG)
QUIT
DO H
+39 ;
+40 SET Y=$EXTRACT(RCDATE,1,5)_"00"
DO DD^%DT
+41 ; write month/year and split amount paid to mccf
+42 WRITE !,Y,?10," |",$JUSTIFY($GET(^TMP("RCBMILL4",$JOB,RCDATE,"TO MCCF")),12,2)," |"
+43 ; write split amount paid to hsif
+44 WRITE $JUSTIFY($GET(^TMP("RCBMILL4",$JOB,RCDATE,"TO HSIF")),12,2)
+45 ; write amount paid to hsif
+46 WRITE $JUSTIFY($GET(^TMP("RCBMILL4",$JOB,RCDATE,"PAID TO HSIF")),12,2)
+47 ; write amount owed to hsif
+48 WRITE $JUSTIFY($GET(^TMP("RCBMILL4",$JOB,RCDATE,"TO HSIF"))-$GET(^TMP("RCBMILL4",$JOB,RCDATE,"PAID TO HSIF")),12,2)," |"
+49 ;
+50 ; get the code sheet data
+51 KILL GECSDATA
+52 DO KEYLOOK^GECSSGET("TR-"_$EXTRACT(RCDATE,1,5)_"00",1)
+53 ;
+54 SET RCAMOUNT=0
+55 IF $GET(GECSDATA)
Begin DoDot:2
+56 SET RCLINE=0
FOR
SET RCLINE=$ORDER(GECSDATA(2100.1,GECSDATA,10,RCLINE))
if 'RCLINE
QUIT
Begin DoDot:3
+57 SET DATA=GECSDATA(2100.1,GECSDATA,10,RCLINE)
+58 IF $PIECE(DATA,"^")'="LIN"
QUIT
+59 IF $PIECE(DATA,"^",6)'="5358.1"
QUIT
+60 IF $PIECE(DATA,"^",21)'="I"
QUIT
+61 SET RCAMOUNT=RCAMOUNT+$PIECE(DATA,"^",20)
End DoDot:3
End DoDot:2
+62 ;
+63 WRITE $JUSTIFY(RCAMOUNT,12,2)
+64 ;
+65 ; total all columns
+66 SET RCTOTAL(1)=$GET(RCTOTAL(1))+$GET(^TMP("RCBMILL4",$JOB,RCDATE,"TO MCCF"))
+67 SET RCTOTAL(2)=$GET(RCTOTAL(2))+$GET(^TMP("RCBMILL4",$JOB,RCDATE,"TO HSIF"))
+68 SET RCTOTAL(3)=$GET(RCTOTAL(3))+$GET(^TMP("RCBMILL4",$JOB,RCDATE,"PAID TO HSIF"))
+69 SET RCTOTAL(5)=$GET(RCTOTAL(5))+RCAMOUNT
End DoDot:1
+70 ;
+71 ; page break
+72 IF $GET(RCRJFLAG)
DO Q
QUIT
+73 IF $Y>(IOSL-5)
if RCSCREEN
DO PAUSE^RCRJRTR1
if $GET(RCRJFLAG)
QUIT
DO H
+74 ;
+75 ; show totals
+76 WRITE !,"==============================================================================="
+77 WRITE !,"TOTALS",?10," |",$JUSTIFY($GET(RCTOTAL(1)),12,2)," |",$JUSTIFY($GET(RCTOTAL(2)),12,2),$JUSTIFY($GET(RCTOTAL(3)),12,2),$JUSTIFY($GET(RCTOTAL(2))-$GET(RCTOTAL(3)),12,2)," |",$JUSTIFY($GET(RCTOTAL(5)),12,2)
+78 WRITE !,"==============================================================================="
+79 ;
+80 ; page break
+81 IF $GET(RCRJFLAG)
DO Q
QUIT
+82 IF $Y>(IOSL-8)
if RCSCREEN
DO PAUSE^RCRJRTR1
if $GET(RCRJFLAG)
QUIT
DO H
+83 ;
+84 ; show what columns mean
+85 WRITE !,"Column 2 is the dollar amount of RX-Copayments that is split to MCCF."
+86 WRITE !,"Column 3 is the dollar amount of RX-Copayments that is split to HSIF."
+87 WRITE !,"Column 4 is the dollar amount of HSIF payments that is paid to HSIF in FMS."
+88 WRITE !,"Column 5 is the dollar difference between columns 3 and 4. This is the amount"
+89 WRITE !," owed (needs to be transferred from MCCF) to HSIF."
+90 WRITE !,"Column 6 is the dollar amount transferred from MCCF to HSIF taken from the"
+91 WRITE !," monthly (TR)ansfer document."
+92 ;
Q ; quit report
+1 KILL ^TMP("RCBMILL4",$JOB)
+2 QUIT
+3 ;
+4 ;
H ; print heading
+1 SET %=RCNOW_" PAGE "_RCPAGE
SET RCPAGE=RCPAGE+1
IF RCPAGE'=2!(RCSCREEN)
WRITE @IOF
+2 WRITE $CHAR(13),"PAYMENTS SPLIT TO HSIF/MCCF HISTORY REPORT",?(79-$LENGTH(%)),%
+3 ;
+4 WRITE !," FROM MONTH/YEAR: ",RCMOYR," TO MONTH/YEAR: ",RCMOYRTO
+5 WRITE !,?10," |",$JUSTIFY("PAYMENTS",12)," |",$JUSTIFY("PAYMENTS",12),$JUSTIFY("PAID TO",12),$JUSTIFY("OWED TO",12)," |",$JUSTIFY("DOCUMENT",12)
+6 WRITE !,"MONTH/YEAR",?10," |",$JUSTIFY("TO MCCF",12)," |",$JUSTIFY("TO HSIF",12),$JUSTIFY("HSIF",12),$JUSTIFY("HSIF",12)," |",$JUSTIFY("AMT TO HSIF",12)
+7 WRITE !,"-------------------------------------------------------------------------------"
+8 QUIT
