RCBMILL3 ;WISC/RFJ-millennium bill report (summary) ; 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
;
;
SUMMARY ; print summary
N DATA,DATA1,RCBILLDA,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
;
; 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 month
. . I $E($P(DATA1,"^",9),1,5)'=$E(RCDATBEG,1,5) 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 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)
;
D TOTALS^RCBMILL2
;
; lookup data in generic code sheets (pass key and 1 for code sheet)
N GECSDATA,RCLINE
D KEYLOOK^GECSSGET("TR-"_RCDATBEG,1)
;
W !!,"TRANSFER DOCUMENT DATA:"
W !,"-----------------------"
I '$G(GECSDATA) W !?5,"Transfer (TR) Document NOT Created for ",RCMOYR
I $G(GECSDATA) D
. W !,"Generic Code Sheet Id: ",$G(GECSDATA(2100.1,GECSDATA,.01,"E"))
. W !," Description: ",$G(GECSDATA(2100.1,GECSDATA,4,"E"))
. W !," Date/Time Created: ",$G(GECSDATA(2100.1,GECSDATA,2,"E"))
. W !," Status: ",$G(GECSDATA(2100.1,GECSDATA,3,"E"))
. ;
. ; page break
. I $Y>(IOSL-5),$O(GECSDATA(2100.1,GECSDATA,10,0)) D:RCSCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H
. W !?6,"Actual Document: "
. F RCLINE=1:1 Q:'$D(GECSDATA(2100.1,GECSDATA,10,RCLINE))!($G(RCRJFLAG)) D
. . W !,GECSDATA(2100.1,GECSDATA,10,RCLINE)
. . I $Y>(IOSL-5),$O(GECSDATA(2100.1,GECSDATA,10,RCLINE)) D:RCSCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H W !?5," Actual Document: <continued>"
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 SUMMARY REPORT",?(79-$L(%)),%
;
W !," FOR THE MONTH/YEAR: ",RCMOYR
W !!,"* * * S U M M A R Y P A G E * * *"
W !,"-------------------------------------------------------------------------------"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCBMILL3 3093 printed Apr 09, 2024@20:47:50 Page 2
RCBMILL3 ;WISC/RFJ-millennium bill report (summary) ; 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 ;
SUMMARY ; print summary
+1 NEW DATA,DATA1,RCBILLDA,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 ; loop the bills with payments
+11 SET RCBILLDA=0
FOR
SET RCBILLDA=$ORDER(^TMP($JOB,"RCBMILLDATA",RCBILLDA))
if 'RCBILLDA
QUIT
Begin DoDot:1
+12 ;
+13 ; loop the transactions
+14 SET RCTRANDA=0
FOR
SET RCTRANDA=$ORDER(^TMP($JOB,"RCBMILLDATA",RCBILLDA,RCTRANDA))
if 'RCTRANDA
QUIT
Begin DoDot:2
+15 ;
+16 ; get the type of transaction
+17 SET DATA1=$GET(^PRCA(433,RCTRANDA,1))
+18 SET TYPE=$PIECE(DATA1,"^",2)
+19 ;
+20 ; only print payments for the selected month
+21 IF $EXTRACT($PIECE(DATA1,"^",9),1,5)'=$EXTRACT(RCDATBEG,1,5)
QUIT
+22 ;
+23 ; if not a payment, quit
+24 IF TYPE'=2
IF TYPE'=34
QUIT
+25 ; data = principal amt of transaction
+26 ; amount owed to mccf
+27 ; amount owed to hsif
+28 ; for payment, amount paid to mccf
+29 ; for payment, amount paid to hsif
+30 SET DATA=^TMP($JOB,"RCBMILLDATA",RCBILLDA,RCTRANDA)
+31 ;
+32 ; compute totals paid for selected report month
+33 ; payment dollars are recorded in data as minus
+34 SET RCTOTALM("TO MCCF")=RCTOTALM("TO MCCF")-$PIECE(DATA,"^",3)
+35 SET RCTOTALM("TO HSIF")=RCTOTALM("TO HSIF")-$PIECE(DATA,"^",4)
+36 SET RCTOTALM("PAID TO HSIF")=RCTOTALM("PAID TO HSIF")+$PIECE(DATA,"^",6)
End DoDot:2
End DoDot:1
+37 ;
+38 DO TOTALS^RCBMILL2
+39 ;
+40 ; lookup data in generic code sheets (pass key and 1 for code sheet)
+41 NEW GECSDATA,RCLINE
+42 DO KEYLOOK^GECSSGET("TR-"_RCDATBEG,1)
+43 ;
+44 WRITE !!,"TRANSFER DOCUMENT DATA:"
+45 WRITE !,"-----------------------"
+46 IF '$GET(GECSDATA)
WRITE !?5,"Transfer (TR) Document NOT Created for ",RCMOYR
+47 IF $GET(GECSDATA)
Begin DoDot:1
+48 WRITE !,"Generic Code Sheet Id: ",$GET(GECSDATA(2100.1,GECSDATA,.01,"E"))
+49 WRITE !," Description: ",$GET(GECSDATA(2100.1,GECSDATA,4,"E"))
+50 WRITE !," Date/Time Created: ",$GET(GECSDATA(2100.1,GECSDATA,2,"E"))
+51 WRITE !," Status: ",$GET(GECSDATA(2100.1,GECSDATA,3,"E"))
+52 ;
+53 ; page break
+54 IF $Y>(IOSL-5)
IF $ORDER(GECSDATA(2100.1,GECSDATA,10,0))
if RCSCREEN
DO PAUSE^RCRJRTR1
if $GET(RCRJFLAG)
QUIT
DO H
+55 WRITE !?6,"Actual Document: "
+56 FOR RCLINE=1:1
if '$DATA(GECSDATA(2100.1,GECSDATA,10,RCLINE))!($GET(RCRJFLAG))
QUIT
Begin DoDot:2
+57 WRITE !,GECSDATA(2100.1,GECSDATA,10,RCLINE)
+58 IF $Y>(IOSL-5)
IF $ORDER(GECSDATA(2100.1,GECSDATA,10,RCLINE))
if RCSCREEN
DO PAUSE^RCRJRTR1
if $GET(RCRJFLAG)
QUIT
DO H
WRITE !?5," Actual Document: <continued>"
End DoDot:2
End DoDot:1
+59 QUIT
+60 ;
+61 ;
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 SUMMARY REPORT",?(79-$LENGTH(%)),%
+3 ;
+4 WRITE !," FOR THE MONTH/YEAR: ",RCMOYR
+5 WRITE !!,"* * * S U M M A R Y P A G E * * *"
+6 WRITE !,"-------------------------------------------------------------------------------"
+7 QUIT
