Routine: RCBMILL2

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.

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 !,"+=============================================================================+"

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 !,"------------------------------+------------+----------------------+-----------+"

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCBMILL2   5635     printed  Apr 23, 2025@17:57:27                                                                                                                                                                                                    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

RCBMILL2.m