- 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 ;**************************************************************
