BARRPTD2 ; IHS/SD/pkd - Payment Summary Report by TDN or Date Range ;06/09/2010
;;1.8;IHS ACCOUNTS RECEIVABLE;**19**;OCT 26, 2005
;
; IHS/SD/PKD - 6/9/10 - V1.8*19 based on BARRPRP* routines
; Routine created
Q
; *********************************************************************
PRINT ;
S BAR(132)=1,BAR(133)=1 ; Width of printing parameters ;pkd
N LOC S LOC=$O(^TMP($J,"BAR-PTD"))
I LOC="" S LOC=DUZ(2) ; Need LOC for Headers
I BARTEXT&($D(^TMP($J,"BAR-PTD"))) D FILEHDR I 1
E D SETHDR
I '$D(^TMP($J,"BAR-PTD")) D Q ; No data - quit
. S IOM=132 D HDB^BARRPSRB
. W !!!!!?25,"*** NO DATA TO PRINT ***"
. D PAZ^BARRUTL S QUIT='Y ;pause
D DETAIL
Q:$G(BAR("F1"))
K ^TMP($J,"BAR-PTD")
;
N TP S TP="C IO(0)" X TP
Q
; ********************************************************************
;
SETHDR ;
; Build header array
I BARTEXT&($D(^TMP($J,"BAR-PTD"))) D FILEHDR Q
S BAR("PG")=0,BAR(133)=1 ; char / line
S BAR("OPT")="TDN"
S BARY("DT")="T"
S BAR("LVL")=0
S BAR("HD",0)="PAYMENT SUMMARY REPORT BY TDN "
;
I BARSRT=1 D ; 1= Batch Range entered
. S BAR("LVL")=BAR("LVL")+1
. S BAR("HD",BAR("LVL"))="Batch Dates: "_$$SDT^BARDUTL(BARSTART)_" to "_$$SDT^BARDUTL(BAREND)
I BARSRT=2 D ; 2 = TDN (1 or more) entered
. S BAR("LVL")=BAR("LVL")+1
. S BAR("HD",BAR("LVL"))="FOR TDNs As Entered "
I $G(LOC) S DUZ(2)=LOC ; if >1 location being processed
S BAR("HD",BAR("LVL"))=BAR("HD",BAR("LVL"))_" "_"LOCATION: "_$P(^BAR(90052.05,DUZ(2),LOC,0),U,4)
;
S BAR("LVL")=BAR("LVL")+1
S BAR("HD",BAR("LVL"))="BATCHED AMOUNT: $"_$J($FN($P($G(^TMP($J,"BAR-PTD")),U,2),",",2),15)
;
S BAR("COL")="W !,""TREASURY DEPOSIT COLLECTION"",?55,""BATCHED POSTED TRUE REFUND TRANSFER UNPOSTED"""
S BAR("COL")=BAR("COL")_",!,"" NUMBER BATCH"",?55,""AMOUNT AMOUNT UNALL AMOUNT AMOUNT AMOUNT """
S BARDASH="W ?22,""----"",?53,""----------"",?64,""----------"""
Q
; ********************************************************************
FILEHDR ; output to file?
Q:$G(FILEHDR) S FILEHDR=1 ; Output headers only once
; File Output Header
N TP S TP="O IO U IO" X TP
S HDR="LOCATION^TDN^COLLECTION BATCH NAME^BATCHED AMOUNT^POSTED AMOUNT"
S HDR=HDR_"^TRUE UNALLOCATED^REFUND AMOUNT^TRANSFER AMOUNT^UNPOSTED AMOUNT"
W !,HDR
Q
;**********************************************
DETAIL ; Print per LOCATION
S LOC="" F S LOC=$O(^TMP($J,"BAR-PTD",LOC)) Q:'LOC D Q:$G(QUIT)
. S LOCANAME=$P(^BAR(90052.05,DUZ(2),LOC,0),U,4)
. D SETHDR ; Get new Location Name
. D:BARSRT=1 DTDET
. D:BARSRT=2 TDNDET
. D LOCTOT
D TOTAL ; Grand Totals
Q
;
DTDET ;
; Print Report - subTotals on Date Change
; Location Change
; SORT1 = DATE SORT2 = TDN
I 'BARTEXT D HDB^BARRPSRB
S SORT1=""
F S SORT1=$O(^TMP($J,"BAR-PTD",LOC,SORT1)) Q:SORT1="" D Q:$G(QUIT)
. S SORT2="" F S SORT2=$O(^TMP($J,"BAR-PTD",LOC,SORT1,SORT2)) Q:SORT2="" D Q:$G(QUIT)
. . S BATCH="" F TCT=0:1 S BATCH=$O(^TMP($J,"BAR-PTD",LOC,SORT1,SORT2,BATCH)) Q:BATCH="" D Q:$G(QUIT)
. . . D DETLN
. . I TCT>1 D TDNSUB ; I >1 COLLECTION BATCH/TDN, print subtotal for TDN
Q
; ********************************************************************
TDNDET ;
; Print Report - SORT1 - TDN SORT2 DT
I 'BARTEXT D HDB^BARRPSRB
S SORT1="" F S SORT1=$O(^TMP($J,"BAR-PTD",LOC,SORT1)) Q:SORT1="" D Q:$G(QUIT)
. S SORT2="" F S SORT2=$O(^TMP($J,"BAR-PTD",LOC,SORT1,SORT2)) Q:SORT2="" D Q:$G(QUIT)
. . S BATCH="" F TCT=0:1 S BATCH=$O(^TMP($J,"BAR-PTD",LOC,SORT1,SORT2,BATCH)) Q:BATCH="" D Q:$G(QUIT)
. . . D DETLN
. . I TCT>1 D TDNSUB ; I >1 COLLECTION BATCH/TDN, print subtotal for TDN
Q
TDNSUB ; print TDN subtotal
Q
;
DETLN ; Same output for DATE RANGE or LIST OF TDN'S
N PC
S LINE=^TMP($J,"BAR-PTD",LOC,SORT1,SORT2,BATCH)
;S Y=$P(SORT2,".",1) X ^DD("DD")
S SORTKEY="SORT1" I BARSRT=1 S SORTKEY="SORT2"
I BARTEXT D FILEOUT Q
W !,@SORTKEY,?21,BATCH,?52
F PC=1:1:6 W $J($P(LINE,",",PC),11,2)
I $Y>(IOSL-5) D PAZ^BARRUTL S QUIT='Y D HDB^BARRPSRB
Q
FILEOUT ; Delimited output to file
W !,LOCANAME,U,@SORTKEY,U,BATCH,U
S LINE=$TR(LINE,",","^") ; Remove this line if for comma delimiter
W LINE
Q
;
LOCTOT ;
I BARTEXT D LOCTOTF Q
I '+BARASK W !
W !?2,"LOCATION TOTAL"
S BARLTOT=^TMP($J,"BAR-PTD",LOC)
D TOTOUT Q
;
LOCTOTF ; File Output
Q U IO ; Leave in case they want totals to output file
W !,"LOCATION TOTAL",U,^TMP($J,"BAR-PTD",LOC)
Q
TOTOUT ;
I BARTEXT D TOTFIL Q
X BARDASH
S BARDSH1=" ----------"
N PC
F PC=1:1:4 W BARDSH1
W !,?21,$J($P(BARLTOT,U),4)
W ?53,$J($FN($P(BARLTOT,U,2),",",2),10)
F PC=3:1:7 W $J($FN($P(BARLTOT,U,PC),",",2),11)
Q:$G(FILEWRITE)
I $O(^TMP($J,"BAR-PTD",LOC)) D PAZ^BARRUTL
Q
; ********************************************************************
;
TOTAL ;
W !
S BARLTOT=^TMP($J,"BAR-PTD")
W !?5,"REPORT TOTAL"
D TOTOUT
S DUZ(2)=DUZ2 ; Restore Log-in Location
N TP S TP="C IO(0)" X TP
Q
;
TOTFIL ;
q U IO ; leave in case they want total lines in output file
W !,"TOTALS: ",U,^TMP($J,"BAR-PTD")
K FILEHDR
N TP S TP="C IO U 0" X TP
;C IO U 0
Q
;**************************************************************
BARRPTD2 ; IHS/SD/pkd - Payment Summary Report by TDN or Date Range ;06/09/2010
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**19**;OCT 26, 2005
+2 ;
+3 ; IHS/SD/PKD - 6/9/10 - V1.8*19 based on BARRPRP* routines
+4 ; Routine created
+5 QUIT
+6 ; *********************************************************************
PRINT ;
+1 ; Width of printing parameters ;pkd
SET BAR(132)=1
SET BAR(133)=1
+2 NEW LOC
SET LOC=$ORDER(^TMP($JOB,"BAR-PTD"))
+3 ; Need LOC for Headers
IF LOC=""
SET LOC=DUZ(2)
+4 IF BARTEXT&($DATA(^TMP($JOB,"BAR-PTD")))
DO FILEHDR
IF 1
+5 IF '$TEST
DO SETHDR
+6 ; No data - quit
IF '$DATA(^TMP($JOB,"BAR-PTD"))
Begin DoDot:1
+7 SET IOM=132
DO HDB^BARRPSRB
+8 WRITE !!!!!?25,"*** NO DATA TO PRINT ***"
+9 ;pause
DO PAZ^BARRUTL
SET QUIT='Y
End DoDot:1
QUIT
+10 DO DETAIL
+11 IF $GET(BAR("F1"))
QUIT
+12 KILL ^TMP($JOB,"BAR-PTD")
+13 ;
+14 NEW TP
SET TP="C IO(0)"
XECUTE TP
+15 QUIT
+16 ; ********************************************************************
+17 ;
SETHDR ;
+1 ; Build header array
+2 IF BARTEXT&($DATA(^TMP($JOB,"BAR-PTD")))
DO FILEHDR
QUIT
+3 ; char / line
SET BAR("PG")=0
SET BAR(133)=1
+4 SET BAR("OPT")="TDN"
+5 SET BARY("DT")="T"
+6 SET BAR("LVL")=0
+7 SET BAR("HD",0)="PAYMENT SUMMARY REPORT BY TDN "
+8 ;
+9 ; 1= Batch Range entered
IF BARSRT=1
Begin DoDot:1
+10 SET BAR("LVL")=BAR("LVL")+1
+11 SET BAR("HD",BAR("LVL"))="Batch Dates: "_$$SDT^BARDUTL(BARSTART)_" to "_$$SDT^BARDUTL(BAREND)
End DoDot:1
+12 ; 2 = TDN (1 or more) entered
IF BARSRT=2
Begin DoDot:1
+13 SET BAR("LVL")=BAR("LVL")+1
+14 SET BAR("HD",BAR("LVL"))="FOR TDNs As Entered "
End DoDot:1
+15 ; if >1 location being processed
IF $GET(LOC)
SET DUZ(2)=LOC
+16 SET BAR("HD",BAR("LVL"))=BAR("HD",BAR("LVL"))_" "_"LOCATION: "_$PIECE(^BAR(90052.05,DUZ(2),LOC,0),U,4)
+17 ;
+18 SET BAR("LVL")=BAR("LVL")+1
+19 SET BAR("HD",BAR("LVL"))="BATCHED AMOUNT: $"_$JUSTIFY($FNUMBER($PIECE($GET(^TMP($JOB,"BAR-PTD")),U,2),",",2),15)
+20 ;
+21 SET BAR("COL")="W !,""TREASURY DEPOSIT COLLECTION"",?55,""BATCHED POSTED TRUE REFUND TRANSFER UNPOSTED"""
+22 SET BAR("COL")=BAR("COL")_",!,"" NUMBER BATCH"",?55,""AMOUNT AMOUNT UNALL AMOUNT AMOUNT AMOUNT """
+23 SET BARDASH="W ?22,""----"",?53,""----------"",?64,""----------"""
+24 QUIT
+25 ; ********************************************************************
FILEHDR ; output to file?
+1 ; Output headers only once
IF $GET(FILEHDR)
QUIT
SET FILEHDR=1
+2 ; File Output Header
+3 NEW TP
SET TP="O IO U IO"
XECUTE TP
+4 SET HDR="LOCATION^TDN^COLLECTION BATCH NAME^BATCHED AMOUNT^POSTED AMOUNT"
+5 SET HDR=HDR_"^TRUE UNALLOCATED^REFUND AMOUNT^TRANSFER AMOUNT^UNPOSTED AMOUNT"
+6 WRITE !,HDR
+7 QUIT
+8 ;**********************************************
DETAIL ; Print per LOCATION
+1 SET LOC=""
FOR
SET LOC=$ORDER(^TMP($JOB,"BAR-PTD",LOC))
IF 'LOC
QUIT
Begin DoDot:1
+2 SET LOCANAME=$PIECE(^BAR(90052.05,DUZ(2),LOC,0),U,4)
+3 ; Get new Location Name
DO SETHDR
+4 IF BARSRT=1
DO DTDET
+5 IF BARSRT=2
DO TDNDET
+6 DO LOCTOT
End DoDot:1
IF $GET(QUIT)
QUIT
+7 ; Grand Totals
DO TOTAL
+8 QUIT
+9 ;
DTDET ;
+1 ; Print Report - subTotals on Date Change
+2 ; Location Change
+3 ; SORT1 = DATE SORT2 = TDN
+4 IF 'BARTEXT
DO HDB^BARRPSRB
+5 SET SORT1=""
+6 FOR
SET SORT1=$ORDER(^TMP($JOB,"BAR-PTD",LOC,SORT1))
IF SORT1=""
QUIT
Begin DoDot:1
+7 SET SORT2=""
FOR
SET SORT2=$ORDER(^TMP($JOB,"BAR-PTD",LOC,SORT1,SORT2))
IF SORT2=""
QUIT
Begin DoDot:2
+8 SET BATCH=""
FOR TCT=0:1
SET BATCH=$ORDER(^TMP($JOB,"BAR-PTD",LOC,SORT1,SORT2,BATCH))
IF BATCH=""
QUIT
Begin DoDot:3
+9 DO DETLN
End DoDot:3
IF $GET(QUIT)
QUIT
+10 ; I >1 COLLECTION BATCH/TDN, print subtotal for TDN
IF TCT>1
DO TDNSUB
End DoDot:2
IF $GET(QUIT)
QUIT
End DoDot:1
IF $GET(QUIT)
QUIT
+11 QUIT
+12 ; ********************************************************************
TDNDET ;
+1 ; Print Report - SORT1 - TDN SORT2 DT
+2 IF 'BARTEXT
DO HDB^BARRPSRB
+3 SET SORT1=""
FOR
SET SORT1=$ORDER(^TMP($JOB,"BAR-PTD",LOC,SORT1))
IF SORT1=""
QUIT
Begin DoDot:1
+4 SET SORT2=""
FOR
SET SORT2=$ORDER(^TMP($JOB,"BAR-PTD",LOC,SORT1,SORT2))
IF SORT2=""
QUIT
Begin DoDot:2
+5 SET BATCH=""
FOR TCT=0:1
SET BATCH=$ORDER(^TMP($JOB,"BAR-PTD",LOC,SORT1,SORT2,BATCH))
IF BATCH=""
QUIT
Begin DoDot:3
+6 DO DETLN
End DoDot:3
IF $GET(QUIT)
QUIT
+7 ; I >1 COLLECTION BATCH/TDN, print subtotal for TDN
IF TCT>1
DO TDNSUB
End DoDot:2
IF $GET(QUIT)
QUIT
End DoDot:1
IF $GET(QUIT)
QUIT
+8 QUIT
TDNSUB ; print TDN subtotal
+1 QUIT
+2 ;
DETLN ; Same output for DATE RANGE or LIST OF TDN'S
+1 NEW PC
+2 SET LINE=^TMP($JOB,"BAR-PTD",LOC,SORT1,SORT2,BATCH)
+3 ;S Y=$P(SORT2,".",1) X ^DD("DD")
+4 SET SORTKEY="SORT1"
IF BARSRT=1
SET SORTKEY="SORT2"
+5 IF BARTEXT
DO FILEOUT
QUIT
+6 WRITE !,@SORTKEY,?21,BATCH,?52
+7 FOR PC=1:1:6
WRITE $JUSTIFY($PIECE(LINE,",",PC),11,2)
+8 IF $Y>(IOSL-5)
DO PAZ^BARRUTL
SET QUIT='Y
DO HDB^BARRPSRB
+9 QUIT
FILEOUT ; Delimited output to file
+1 WRITE !,LOCANAME,U,@SORTKEY,U,BATCH,U
+2 ; Remove this line if for comma delimiter
SET LINE=$TRANSLATE(LINE,",","^")
+3 WRITE LINE
+4 QUIT
+5 ;
LOCTOT ;
+1 IF BARTEXT
DO LOCTOTF
QUIT
+2 IF '+BARASK
WRITE !
+3 WRITE !?2,"LOCATION TOTAL"
+4 SET BARLTOT=^TMP($JOB,"BAR-PTD",LOC)
+5 DO TOTOUT
QUIT
+6 ;
LOCTOTF ; File Output
+1 ; Leave in case they want totals to output file
QUIT
USE IO
+2 WRITE !,"LOCATION TOTAL",U,^TMP($JOB,"BAR-PTD",LOC)
+3 QUIT
TOTOUT ;
+1 IF BARTEXT
DO TOTFIL
QUIT
+2 XECUTE BARDASH
+3 SET BARDSH1=" ----------"
+4 NEW PC
+5 FOR PC=1:1:4
WRITE BARDSH1
+6 WRITE !,?21,$JUSTIFY($PIECE(BARLTOT,U),4)
+7 WRITE ?53,$JUSTIFY($FNUMBER($PIECE(BARLTOT,U,2),",",2),10)
+8 FOR PC=3:1:7
WRITE $JUSTIFY($FNUMBER($PIECE(BARLTOT,U,PC),",",2),11)
+9 IF $GET(FILEWRITE)
QUIT
+10 IF $ORDER(^TMP($JOB,"BAR-PTD",LOC))
DO PAZ^BARRUTL
+11 QUIT
+12 ; ********************************************************************
+13 ;
TOTAL ;
+1 WRITE !
+2 SET BARLTOT=^TMP($JOB,"BAR-PTD")
+3 WRITE !?5,"REPORT TOTAL"
+4 DO TOTOUT
+5 ; Restore Log-in Location
SET DUZ(2)=DUZ2
+6 NEW TP
SET TP="C IO(0)"
XECUTE TP
+7 QUIT
+8 ;
TOTFIL ;
+1 ; leave in case they want total lines in output file
QUIT
USE IO
+2 WRITE !,"TOTALS: ",U,^TMP($JOB,"BAR-PTD")
+3 KILL FILEHDR
+4 NEW TP
SET TP="C IO U 0"
XECUTE TP
+5 ;C IO U 0
+6 QUIT
+7 ;**************************************************************
