RCBMILL2 ;WISC/RFJ-millennium bill report (transactions) ; 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 report
N DATA,DATA1,DATE,HSIFBAL,RCBILLDA,RCDPDATA,RCTOTAL,RCTOTALM,RCTRANDA,TYPE
;
U IO D H
;
; intialize totals for month
S RCTOTALM("TO MCCF")=0
S RCTOTALM("TO HSIF")=0
S RCTOTALM("PAID TO HSIF")=0
;
S RCBILLDA=0 F S RCBILLDA=$O(^TMP($J,"RCBMILLDATA",RCBILLDA)) Q:'RCBILLDA!($G(RCRJFLAG)) D
. ;
. ; page break
. I $Y>(IOSL-3) D:RCSCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H
. ;
. ; write bill data
. D DIQ430^RCDPBPLM(RCBILLDA,".01;8;")
. W !,"BILL: ",$P(RCDPDATA(430,RCBILLDA,.01,"E"),"-",2)
. W ?15,"STATUS: ",$E(RCDPDATA(430,RCBILLDA,8,"E"),1,7)
. K RCDPDATA(430,RCBILLDA)
. W ?30,"+------------+----------------------+-----------+"
. ;
. ; intialize totals for bill
. S RCTOTAL("PRINCIPAL")=0
. S RCTOTAL("TO MCCF")=0
. S RCTOTAL("TO HSIF")=0
. S RCTOTAL("TRANSFER TO HSIF")=0
. ;
. S RCTRANDA=0 F S RCTRANDA=$O(^TMP($J,"RCBMILLDATA",RCBILLDA,RCTRANDA)) Q:'RCTRANDA!($G(RCRJFLAG)) D
. . ; data = type of transaction
. . ; 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)
. . ;
. . ; get the date and type of transaction
. . S DATA1=$G(^PRCA(433,RCTRANDA,1))
. . S DATE=$E($P(DATA1,"^",9),4,5)_"/"_$E($P(DATA1,"^",9),6,7)_"/"_$E($P(DATA1,"^",9),2,3)
. . S TYPE=$P(DATA1,"^",2)
. . S TYPE=$S(TYPE=1:"Increase",TYPE=35:"Decrease",TYPE=2:"Pay Part",TYPE=34:"Pay Full",43:"Re-estab",1:"Unknown")
. . ;
. . ; page break
. . I $Y>(IOSL-3) D:RCSCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H
. . ;
. . ; write data
. . W !,RCTRANDA
. . W ?10,DATE
. . W ?20,TYPE
. . W ?30,"|"
. . W $J($P(DATA,"^",2),10,2)
. . W " |"
. . W $J($P(DATA,"^",3),10,2)
. . I $P(DATA,"^",4) W $J($P(DATA,"^",4),10,2)
. . W ?64," |"
. . ;
. . ; if it is a payment transaction, show if there is a
. . ; balance owed to hsif
. . S HSIFBAL=0
. . I $P(DATA1,"^",2)=2!($P(DATA1,"^",2)=34) D
. . . ; get the amount owed to hsif based on what has been paid
. . . S HSIFBAL=$P(DATA,"^",4)+$P(DATA,"^",6)
. . . I HSIFBAL W $J(-HSIFBAL,10,2)
. . . I 'HSIFBAL,$P(DATA,"^",6) W $J("paid",10)
. . . ;
. . . ; compute totals paid for selected report month
. . . ; payment dollars are recorded in data as minus
. . . I $E($P(DATA1,"^",9),1,5)'=$E(RCDATBEG,1,5) Q
. . . S RCTOTALM("TO MCCF")=RCTOTALM("TO MCCF")-$P(DATA,"^",3)
. . . S RCTOTALM("TO HSIF")=RCTOTALM("TO HSIF")-$P(DATA,"^",4)
. . . S RCTOTALM("PAID TO HSIF")=RCTOTALM("PAID TO HSIF")+$P(DATA,"^",6)
. . ;
. . W ?78,"|"
. . ;
. . ; store totals by bill
. . S RCTOTAL("PRINCIPAL")=RCTOTAL("PRINCIPAL")+$P(DATA,"^",2)
. . S RCTOTAL("TO MCCF")=RCTOTAL("TO MCCF")+$P(DATA,"^",3)
. . S RCTOTAL("TO HSIF")=RCTOTAL("TO HSIF")+$P(DATA,"^",4)
. . S RCTOTAL("TRANSFER TO HSIF")=RCTOTAL("TRANSFER TO HSIF")+HSIFBAL
. ;
. ; page break
. I $G(RCRJFLAG) Q
. I $Y>(IOSL-4) D:RCSCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H
. ;
. ; show totals by each bill
. W !?30,"+------------+----------------------+-----------+"
. W !?20,"BALANCES"
. W ?31,$J(RCTOTAL("PRINCIPAL"),10,2)
. W " "
. W $J(RCTOTAL("TO MCCF"),10,2)
. W $J(RCTOTAL("TO HSIF"),10,2)
. W " |"
. W $J(-RCTOTAL("TRANSFER TO HSIF"),10,2)
. W ?78,"|"
;
I $G(RCRJFLAG) Q
;
I $O(^TMP($J,"RCBMILLDATA",0)) W !?66,"+-----------+"
;
; page break
I $G(RCRJFLAG) Q
I $Y>(IOSL-9) D:RCSCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H
;
TOTALS ; show monthly totals (called by the other reports)
;
W !,"+=============================================================================+"
W !,"|",?2,"TOTAL RX-COPAYMENTS FOR MONTH: ",$J(RCMOYR,10),?78,"|"
W !,"|",?2," SPLIT PAID TO MCCF: ",$J(RCTOTALM("TO MCCF"),10,2),?78,"|"
W !,"|",?2," SPLIT PAID TO HSIF: ",$J(RCTOTALM("TO HSIF"),10,2),?78,"|"
W !,"|",?45,"ALREADY PAID TO HSIF: ",$J(RCTOTALM("PAID TO HSIF"),10,2),?78,"|"
W !,"|",?45,"BALANCE OWED TO HSIF: ",$J(RCTOTALM("TO HSIF")-RCTOTALM("PAID TO HSIF"),10,2),?78,"|"
W !,"|",?2," ",$J("----------",10),?78,"|"
W !,"|",?2," TOTAL RX-COPAYMENTS RECEIVED: ",$J(RCTOTALM("TO MCCF")+RCTOTALM("TO HSIF"),10,2),?78,"|"
W !,"+=============================================================================+"
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 REPORT",?(79-$L(%)),%
;
W !," FOR THE MONTH/YEAR: ",RCMOYR
W ?30,"+------------+----------------------+-----------+"
;
W !?30,"|"
W $J("PRINCIP",10)
W " |"
W $J("FUND SPLIT",16)
W " |"
W $J("TRANSFER",10)
W ?78,"|"
;
W !,"TRANS #"
W ?10,"PROCDATE"
W ?20,"TYPE"
W ?30,"|"
W $J("AMOUNT",10)
W " |"
W $J("TO MCCF",10)
W $J("TO HSIF",10)
W " |"
W $J("TO HSIF",10)
W ?78,"|"
;
W !,"------------------------------+------------+----------------------+-----------+"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCBMILL2 5635 printed Oct 16, 2024@17:43:51 Page 2
RCBMILL2 ;WISC/RFJ-millennium bill report (transactions) ; 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 report
+1 NEW DATA,DATA1,DATE,HSIFBAL,RCBILLDA,RCDPDATA,RCTOTAL,RCTOTALM,RCTRANDA,TYPE
+2 ;
+3 USE IO
DO H
+4 ;
+5 ; intialize totals for month
+6 SET RCTOTALM("TO MCCF")=0
+7 SET RCTOTALM("TO HSIF")=0
+8 SET RCTOTALM("PAID TO HSIF")=0
+9 ;
+10 SET RCBILLDA=0
FOR
SET RCBILLDA=$ORDER(^TMP($JOB,"RCBMILLDATA",RCBILLDA))
if 'RCBILLDA!($GET(RCRJFLAG))
QUIT
Begin DoDot:1
+11 ;
+12 ; page break
+13 IF $Y>(IOSL-3)
if RCSCREEN
DO PAUSE^RCRJRTR1
if $GET(RCRJFLAG)
QUIT
DO H
+14 ;
+15 ; write bill data
+16 DO DIQ430^RCDPBPLM(RCBILLDA,".01;8;")
+17 WRITE !,"BILL: ",$PIECE(RCDPDATA(430,RCBILLDA,.01,"E"),"-",2)
+18 WRITE ?15,"STATUS: ",$EXTRACT(RCDPDATA(430,RCBILLDA,8,"E"),1,7)
+19 KILL RCDPDATA(430,RCBILLDA)
+20 WRITE ?30,"+------------+----------------------+-----------+"
+21 ;
+22 ; intialize totals for bill
+23 SET RCTOTAL("PRINCIPAL")=0
+24 SET RCTOTAL("TO MCCF")=0
+25 SET RCTOTAL("TO HSIF")=0
+26 SET RCTOTAL("TRANSFER TO HSIF")=0
+27 ;
+28 SET RCTRANDA=0
FOR
SET RCTRANDA=$ORDER(^TMP($JOB,"RCBMILLDATA",RCBILLDA,RCTRANDA))
if 'RCTRANDA!($GET(RCRJFLAG))
QUIT
Begin DoDot:2
+29 ; data = type of transaction
+30 ; principal amt of transaction
+31 ; amount owed to mccf
+32 ; amount owed to hsif
+33 ; for payment, amount paid to mccf
+34 ; for payment, amount paid to hsif
+35 SET DATA=^TMP($JOB,"RCBMILLDATA",RCBILLDA,RCTRANDA)
+36 ;
+37 ; get the date and type of transaction
+38 SET DATA1=$GET(^PRCA(433,RCTRANDA,1))
+39 SET DATE=$EXTRACT($PIECE(DATA1,"^",9),4,5)_"/"_$EXTRACT($PIECE(DATA1,"^",9),6,7)_"/"_$EXTRACT($PIECE(DATA1,"^",9),2,3)
+40 SET TYPE=$PIECE(DATA1,"^",2)
+41 SET TYPE=$SELECT(TYPE=1:"Increase",TYPE=35:"Decrease",TYPE=2:"Pay Part",TYPE=34:"Pay Full",43:"Re-estab",1:"Unknown")
+42 ;
+43 ; page break
+44 IF $Y>(IOSL-3)
if RCSCREEN
DO PAUSE^RCRJRTR1
if $GET(RCRJFLAG)
QUIT
DO H
+45 ;
+46 ; write data
+47 WRITE !,RCTRANDA
+48 WRITE ?10,DATE
+49 WRITE ?20,TYPE
+50 WRITE ?30,"|"
+51 WRITE $JUSTIFY($PIECE(DATA,"^",2),10,2)
+52 WRITE " |"
+53 WRITE $JUSTIFY($PIECE(DATA,"^",3),10,2)
+54 IF $PIECE(DATA,"^",4)
WRITE $JUSTIFY($PIECE(DATA,"^",4),10,2)
+55 WRITE ?64," |"
+56 ;
+57 ; if it is a payment transaction, show if there is a
+58 ; balance owed to hsif
+59 SET HSIFBAL=0
+60 IF $PIECE(DATA1,"^",2)=2!($PIECE(DATA1,"^",2)=34)
Begin DoDot:3
+61 ; get the amount owed to hsif based on what has been paid
+62 SET HSIFBAL=$PIECE(DATA,"^",4)+$PIECE(DATA,"^",6)
+63 IF HSIFBAL
WRITE $JUSTIFY(-HSIFBAL,10,2)
+64 IF 'HSIFBAL
IF $PIECE(DATA,"^",6)
WRITE $JUSTIFY("paid",10)
+65 ;
+66 ; compute totals paid for selected report month
+67 ; payment dollars are recorded in data as minus
+68 IF $EXTRACT($PIECE(DATA1,"^",9),1,5)'=$EXTRACT(RCDATBEG,1,5)
QUIT
+69 SET RCTOTALM("TO MCCF")=RCTOTALM("TO MCCF")-$PIECE(DATA,"^",3)
+70 SET RCTOTALM("TO HSIF")=RCTOTALM("TO HSIF")-$PIECE(DATA,"^",4)
+71 SET RCTOTALM("PAID TO HSIF")=RCTOTALM("PAID TO HSIF")+$PIECE(DATA,"^",6)
End DoDot:3
+72 ;
+73 WRITE ?78,"|"
+74 ;
+75 ; store totals by bill
+76 SET RCTOTAL("PRINCIPAL")=RCTOTAL("PRINCIPAL")+$PIECE(DATA,"^",2)
+77 SET RCTOTAL("TO MCCF")=RCTOTAL("TO MCCF")+$PIECE(DATA,"^",3)
+78 SET RCTOTAL("TO HSIF")=RCTOTAL("TO HSIF")+$PIECE(DATA,"^",4)
+79 SET RCTOTAL("TRANSFER TO HSIF")=RCTOTAL("TRANSFER TO HSIF")+HSIFBAL
End DoDot:2
+80 ;
+81 ; page break
+82 IF $GET(RCRJFLAG)
QUIT
+83 IF $Y>(IOSL-4)
if RCSCREEN
DO PAUSE^RCRJRTR1
if $GET(RCRJFLAG)
QUIT
DO H
+84 ;
+85 ; show totals by each bill
+86 WRITE !?30,"+------------+----------------------+-----------+"
+87 WRITE !?20,"BALANCES"
+88 WRITE ?31,$JUSTIFY(RCTOTAL("PRINCIPAL"),10,2)
+89 WRITE " "
+90 WRITE $JUSTIFY(RCTOTAL("TO MCCF"),10,2)
+91 WRITE $JUSTIFY(RCTOTAL("TO HSIF"),10,2)
+92 WRITE " |"
+93 WRITE $JUSTIFY(-RCTOTAL("TRANSFER TO HSIF"),10,2)
+94 WRITE ?78,"|"
End DoDot:1
+95 ;
+96 IF $GET(RCRJFLAG)
QUIT
+97 ;
+98 IF $ORDER(^TMP($JOB,"RCBMILLDATA",0))
WRITE !?66,"+-----------+"
+99 ;
+100 ; page break
+101 IF $GET(RCRJFLAG)
QUIT
+102 IF $Y>(IOSL-9)
if RCSCREEN
DO PAUSE^RCRJRTR1
if $GET(RCRJFLAG)
QUIT
DO H
+103 ;
TOTALS ; show monthly totals (called by the other reports)
+1 ;
+2 WRITE !,"+=============================================================================+"
+3 WRITE !,"|",?2,"TOTAL RX-COPAYMENTS FOR MONTH: ",$JUSTIFY(RCMOYR,10),?78,"|"
+4 WRITE !,"|",?2," SPLIT PAID TO MCCF: ",$JUSTIFY(RCTOTALM("TO MCCF"),10,2),?78,"|"
+5 WRITE !,"|",?2," SPLIT PAID TO HSIF: ",$JUSTIFY(RCTOTALM("TO HSIF"),10,2),?78,"|"
+6 WRITE !,"|",?45,"ALREADY PAID TO HSIF: ",$JUSTIFY(RCTOTALM("PAID TO HSIF"),10,2),?78,"|"
+7 WRITE !,"|",?45,"BALANCE OWED TO HSIF: ",$JUSTIFY(RCTOTALM("TO HSIF")-RCTOTALM("PAID TO HSIF"),10,2),?78,"|"
+8 WRITE !,"|",?2," ",$JUSTIFY("----------",10),?78,"|"
+9 WRITE !,"|",?2," TOTAL RX-COPAYMENTS RECEIVED: ",$JUSTIFY(RCTOTALM("TO MCCF")+RCTOTALM("TO HSIF"),10,2),?78,"|"
+10 WRITE !,"+=============================================================================+"
+11 QUIT
+12 ;
+13 ;
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 REPORT",?(79-$LENGTH(%)),%
+3 ;
+4 WRITE !," FOR THE MONTH/YEAR: ",RCMOYR
+5 WRITE ?30,"+------------+----------------------+-----------+"
+6 ;
+7 WRITE !?30,"|"
+8 WRITE $JUSTIFY("PRINCIP",10)
+9 WRITE " |"
+10 WRITE $JUSTIFY("FUND SPLIT",16)
+11 WRITE " |"
+12 WRITE $JUSTIFY("TRANSFER",10)
+13 WRITE ?78,"|"
+14 ;
+15 WRITE !,"TRANS #"
+16 WRITE ?10,"PROCDATE"
+17 WRITE ?20,"TYPE"
+18 WRITE ?30,"|"
+19 WRITE $JUSTIFY("AMOUNT",10)
+20 WRITE " |"
+21 WRITE $JUSTIFY("TO MCCF",10)
+22 WRITE $JUSTIFY("TO HSIF",10)
+23 WRITE " |"
+24 WRITE $JUSTIFY("TO HSIF",10)
+25 WRITE ?78,"|"
+26 ;
+27 WRITE !,"------------------------------+------------+----------------------+-----------+"
+28 QUIT
