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