BARRPRP2 ; IHS/SD/LSL - Payment Summary Report by Collection Batch ;08/20/2008
;;1.8;IHS ACCOUNTS RECEIVABLE;**7**;OCT 26, 2005
; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892
; IHS/SD/LSL - 04/18/03 - V1.8
; Routine created
Q
; *********************************************************************
PRINT ;
D SETHDR
I '$D(^TMP($J,"BAR-PRP")) D Q ; No data - quit
. D HDB^BARRPSRB
. W !!!!!?25,"*** NO DATA TO PRINT ***"
D:+BARASK PRTCV
D:'+BARASK PRTDET
Q:$G(BAR("F1"))
D PRTBATCH
K ^TMP($J,"BAR-PRP")
Q
; ********************************************************************
;
SETHDR ;
; Build header array
S BAR("PG")=0
S BAR("OPT")="PRP"
S BARY("DT")="T"
S BAR("LVL")=0
S BAR("HD",0)="PAYMENT SUMMARY REPORT"
;
I $D(BARY("ITYP")) D
. S BAR("LVL")=BAR("LVL")+1
. S BAR("HD",BAR("LVL"))="FOR INSURER TYPE: "_BARY("ITYP","NM")
I $D(BARY("COLPT")) D
. S BAR("LVL")=BAR("LVL")+1
. S BAR("HD",BAR("LVL"))="FOR COLLECTION POINT: "_BARY("COLPT","NM")
;
S BAR("LVL")=BAR("LVL")+1
S BAR("HD",BAR("LVL"))="BATCH DATES OF "
S BAR("HD",BAR("LVL"))=BAR("HD",BAR("LVL"))_$$SDT^BARDUTL(BARSTART)
S BAR("HD",BAR("LVL"))=BAR("HD",BAR("LVL"))_" TO "
S BAR("HD",BAR("LVL"))=BAR("HD",BAR("LVL"))_$$SDT^BARDUTL(BAREND)
;
S BAR("LVL")=BAR("LVL")+1
S BAR("HD",BAR("LVL"))="BATCHED AMOUNT: $"_$J($FN($P($G(BARBTOT),U),",",2),15)
;
S BAR("COL")="W !?2,""MONTH"",?16,""# BILLS"",?26,""BILLED AMOUNT"",?48,""PAYMENTS"""
S BARDASH="W ?18,""----"",?24,""---------------"",?41,""---------------"""
S BAREQUAL="W !?18,""===="",?24,""==============="",?41,""==============="""
K BARTOT
Q
; ********************************************************************
; ********************************************************************
;
PRTCV ;
; Print Report sorted by Clinic/Visit Type
D HDB^BARRPSRB
S BARVIS=""
F S BARVIS=$O(^TMP($J,"BAR-PRP",BARVIS)) Q:BARVIS="" D LOCCV Q:$G(BAR("F1"))
D TOTAL
Q
; ********************************************************************
;
LOCCV ;
; For each visit location do (clinic/visit type)
K BARLTOT
W !,"VISIT LOCATION: ",BARVIS
S BARS=""
F S BARS=$O(^TMP($J,"BAR-PRP",BARVIS,BARS)) Q:BARS="" D SORTCV Q:$G(BAR("F1"))
D LOCTOT
Q
; ********************************************************************
;
SORTCV ;
; For each clinic/visit type do...
K BARCVTOT
W:BARY("SORT")="C" !?3,"CLINIC: ",BARS,!
W:BARY("SORT")="V" !?3,"VISIT TYPE: ",BARS,!
S BARDOS=0
F S BARDOS=$O(^TMP($J,"BAR-PRP",BARVIS,BARS,BARDOS)) Q:'+BARDOS D Q:$G(BAR("F1"))
. S BARHOLD=$G(^TMP($J,"BAR-PRP",BARVIS,BARS,BARDOS))
. D DETAIL
. D GETOTCV
. D GETOT
W !
X BARDASH
W:BARY("SORT")="C" !?5,"CLINIC TOTAL"
W:BARY("SORT")="V" !?1,"VISIT TYPE TOTAL"
W ?18,$J($P(BARCVTOT,U),4)
W ?24,$J($FN($P(BARCVTOT,U,2),",",2),15)
W ?41,$J($FN($P(BARCVTOT,U,3),",",2),15)
W !
Q
; ********************************************************************
;
DETAIL ;
; Detail line
I $Y>(IOSL-5) D HD^BARRPSRB Q:$G(BAR("F1"))
S Y=BARDOS
D DD^%DT
W !?2,Y ; DOS (Month/year)
W ?18,$J($P(BARHOLD,U),4) ; Bill count
W ?24,$J($FN($P(BARHOLD,U,2),",",2),15) ; Billed Amount
W ?41,$J($FN($P(BARHOLD,U,3),",",2),15) ; Paid Amount
Q
; ********************************************************************
;
GETOTCV ;
; Get clinic/visit subtotal
S $P(BARCVTOT,U)=$P($G(BARCVTOT),U)+$P(BARHOLD,U)
S $P(BARCVTOT,U,2)=$P($G(BARCVTOT),U,2)+$P(BARHOLD,U,2)
S $P(BARCVTOT,U,3)=$P($G(BARCVTOT),U,3)+$P(BARHOLD,U,3)
Q
; ********************************************************************
;
GETOT ;
; Get visit location subtotal
S $P(BARLTOT,U)=$P($G(BARLTOT),U)+$P(BARHOLD,U)
S $P(BARLTOT,U,2)=$P($G(BARLTOT),U,2)+$P(BARHOLD,U,2)
S $P(BARLTOT,U,3)=$P($G(BARLTOT),U,3)+$P(BARHOLD,U,3)
; Get report total
S $P(BARTOT,U)=$P($G(BARTOT),U)+$P(BARHOLD,U)
S $P(BARTOT,U,2)=$P($G(BARTOT),U,2)+$P(BARHOLD,U,2)
S $P(BARTOT,U,3)=$P($G(BARTOT),U,3)+$P(BARHOLD,U,3)
Q
; ********************************************************************
;
LOCTOT ;
I '+BARASK W !
X BARDASH
W !?2,"VISIT LOC TOTAL"
W ?18,$J($P(BARLTOT,U),4)
W ?24,$J($FN($P(BARLTOT,U,2),",",2),15)
W ?41,$J($FN($P(BARLTOT,U,3),",",2),15)
Q
; ********************************************************************
;
TOTAL ;
X BAREQUAL
W !?5,"REPORT TOTAL"
W ?18,$J($P(BARTOT,U),4)
W ?24,$J($FN($P(BARTOT,U,2),",",2),15)
W ?41,$J($FN($P(BARTOT,U,3),",",2),15)
Q
; ********************************************************************
; ********************************************************************
;
PRTDET ;
; Print Detail Report
D HDB^BARRPSRB
S BARVIS=""
F S BARVIS=$O(^TMP($J,"BAR-PRP",BARVIS)) Q:BARVIS="" D LOC Q:$G(BAR("F1"))
D TOTAL
Q
; ********************************************************************
;
LOC ;
; For each visit location do (clinic/visit type)
K BARLTOT
W !,"VISIT LOCATION: ",BARVIS,!
S BARDOS=0
F S BARDOS=$O(^TMP($J,"BAR-PRP",BARVIS,BARDOS)) Q:'+BARDOS D Q:$G(BAR("F1"))
. S BARHOLD=$G(^TMP($J,"BAR-PRP",BARVIS,BARDOS))
. D DETAIL
. D GETOT
D LOCTOT
Q
; ********************************************************************
;
PRTBATCH ;
; Print batch listing at end of report
D PAZ^BARRUTL
Q:$G(BAR("F1"))
S BAREQUAL="W !?31,""==============="",?47,""==============="",?63,""==============="""
S BATHDR=" ** BATCH LISTING **"
S BARLVL=$O(BAR("HD",99),-1)
S BAR("HD",BARLVL)=BAR("HD",BARLVL)_BATHDR
S BAR("COL")="W !,""COLLECTION BATCHES"",?32,""BATCHED AMOUNT"",?49,""POSTED AMOUNT"",?63,""UNPOSTED AMOUNT"""
D HDB^BARRPSRB
S BARBNAME=""
F S BARBNAME=$O(BARB(BARBNAME)) Q:BARBNAME="" D BATCHDET Q:$G(BAR("F1"))
X BAREQUAL
W !?20,"TOTALS"
W ?31,$J($FN($P(BARBTOT,U),",",2),15)
W ?47,$J($FN($P(BARBTOT,U,2),",",2),15)
W ?63,$J($FN($P(BARBTOT,U,3),",",2),15)
Q
; ********************************************************************
;
BATCHDET ;
; Write batch detail lines
S BARHOLD=$G(BARB(BARBNAME))
W !,$E(BARBNAME,1,30)
W ?31,$J($FN($P(BARHOLD,U),",",2),15)
W ?47,$J($FN($P(BARHOLD,U,2),",",2),15)
W ?63,$J($FN($P(BARHOLD,U,3),",",2),15)
Q
BARRPRP2 ; IHS/SD/LSL - Payment Summary Report by Collection Batch ;08/20/2008
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**7**;OCT 26, 2005
+2 ; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892
+3 ; IHS/SD/LSL - 04/18/03 - V1.8
+4 ; Routine created
+5 QUIT
+6 ; *********************************************************************
PRINT ;
+1 DO SETHDR
+2 ; No data - quit
IF '$DATA(^TMP($JOB,"BAR-PRP"))
Begin DoDot:1
+3 DO HDB^BARRPSRB
+4 WRITE !!!!!?25,"*** NO DATA TO PRINT ***"
End DoDot:1
QUIT
+5 IF +BARASK
DO PRTCV
+6 IF '+BARASK
DO PRTDET
+7 IF $GET(BAR("F1"))
QUIT
+8 DO PRTBATCH
+9 KILL ^TMP($JOB,"BAR-PRP")
+10 QUIT
+11 ; ********************************************************************
+12 ;
SETHDR ;
+1 ; Build header array
+2 SET BAR("PG")=0
+3 SET BAR("OPT")="PRP"
+4 SET BARY("DT")="T"
+5 SET BAR("LVL")=0
+6 SET BAR("HD",0)="PAYMENT SUMMARY REPORT"
+7 ;
+8 IF $DATA(BARY("ITYP"))
Begin DoDot:1
+9 SET BAR("LVL")=BAR("LVL")+1
+10 SET BAR("HD",BAR("LVL"))="FOR INSURER TYPE: "_BARY("ITYP","NM")
End DoDot:1
+11 IF $DATA(BARY("COLPT"))
Begin DoDot:1
+12 SET BAR("LVL")=BAR("LVL")+1
+13 SET BAR("HD",BAR("LVL"))="FOR COLLECTION POINT: "_BARY("COLPT","NM")
End DoDot:1
+14 ;
+15 SET BAR("LVL")=BAR("LVL")+1
+16 SET BAR("HD",BAR("LVL"))="BATCH DATES OF "
+17 SET BAR("HD",BAR("LVL"))=BAR("HD",BAR("LVL"))_$$SDT^BARDUTL(BARSTART)
+18 SET BAR("HD",BAR("LVL"))=BAR("HD",BAR("LVL"))_" TO "
+19 SET BAR("HD",BAR("LVL"))=BAR("HD",BAR("LVL"))_$$SDT^BARDUTL(BAREND)
+20 ;
+21 SET BAR("LVL")=BAR("LVL")+1
+22 SET BAR("HD",BAR("LVL"))="BATCHED AMOUNT: $"_$JUSTIFY($FNUMBER($PIECE($GET(BARBTOT),U),",",2),15)
+23 ;
+24 SET BAR("COL")="W !?2,""MONTH"",?16,""# BILLS"",?26,""BILLED AMOUNT"",?48,""PAYMENTS"""
+25 SET BARDASH="W ?18,""----"",?24,""---------------"",?41,""---------------"""
+26 SET BAREQUAL="W !?18,""===="",?24,""==============="",?41,""==============="""
+27 KILL BARTOT
+28 QUIT
+29 ; ********************************************************************
+30 ; ********************************************************************
+31 ;
PRTCV ;
+1 ; Print Report sorted by Clinic/Visit Type
+2 DO HDB^BARRPSRB
+3 SET BARVIS=""
+4 FOR
SET BARVIS=$ORDER(^TMP($JOB,"BAR-PRP",BARVIS))
IF BARVIS=""
QUIT
DO LOCCV
IF $GET(BAR("F1"))
QUIT
+5 DO TOTAL
+6 QUIT
+7 ; ********************************************************************
+8 ;
LOCCV ;
+1 ; For each visit location do (clinic/visit type)
+2 KILL BARLTOT
+3 WRITE !,"VISIT LOCATION: ",BARVIS
+4 SET BARS=""
+5 FOR
SET BARS=$ORDER(^TMP($JOB,"BAR-PRP",BARVIS,BARS))
IF BARS=""
QUIT
DO SORTCV
IF $GET(BAR("F1"))
QUIT
+6 DO LOCTOT
+7 QUIT
+8 ; ********************************************************************
+9 ;
SORTCV ;
+1 ; For each clinic/visit type do...
+2 KILL BARCVTOT
+3 IF BARY("SORT")="C"
WRITE !?3,"CLINIC: ",BARS,!
+4 IF BARY("SORT")="V"
WRITE !?3,"VISIT TYPE: ",BARS,!
+5 SET BARDOS=0
+6 FOR
SET BARDOS=$ORDER(^TMP($JOB,"BAR-PRP",BARVIS,BARS,BARDOS))
IF '+BARDOS
QUIT
Begin DoDot:1
+7 SET BARHOLD=$GET(^TMP($JOB,"BAR-PRP",BARVIS,BARS,BARDOS))
+8 DO DETAIL
+9 DO GETOTCV
+10 DO GETOT
End DoDot:1
IF $GET(BAR("F1"))
QUIT
+11 WRITE !
+12 XECUTE BARDASH
+13 IF BARY("SORT")="C"
WRITE !?5,"CLINIC TOTAL"
+14 IF BARY("SORT")="V"
WRITE !?1,"VISIT TYPE TOTAL"
+15 WRITE ?18,$JUSTIFY($PIECE(BARCVTOT,U),4)
+16 WRITE ?24,$JUSTIFY($FNUMBER($PIECE(BARCVTOT,U,2),",",2),15)
+17 WRITE ?41,$JUSTIFY($FNUMBER($PIECE(BARCVTOT,U,3),",",2),15)
+18 WRITE !
+19 QUIT
+20 ; ********************************************************************
+21 ;
DETAIL ;
+1 ; Detail line
+2 IF $Y>(IOSL-5)
DO HD^BARRPSRB
IF $GET(BAR("F1"))
QUIT
+3 SET Y=BARDOS
+4 DO DD^%DT
+5 ; DOS (Month/year)
WRITE !?2,Y
+6 ; Bill count
WRITE ?18,$JUSTIFY($PIECE(BARHOLD,U),4)
+7 ; Billed Amount
WRITE ?24,$JUSTIFY($FNUMBER($PIECE(BARHOLD,U,2),",",2),15)
+8 ; Paid Amount
WRITE ?41,$JUSTIFY($FNUMBER($PIECE(BARHOLD,U,3),",",2),15)
+9 QUIT
+10 ; ********************************************************************
+11 ;
GETOTCV ;
+1 ; Get clinic/visit subtotal
+2 SET $PIECE(BARCVTOT,U)=$PIECE($GET(BARCVTOT),U)+$PIECE(BARHOLD,U)
+3 SET $PIECE(BARCVTOT,U,2)=$PIECE($GET(BARCVTOT),U,2)+$PIECE(BARHOLD,U,2)
+4 SET $PIECE(BARCVTOT,U,3)=$PIECE($GET(BARCVTOT),U,3)+$PIECE(BARHOLD,U,3)
+5 QUIT
+6 ; ********************************************************************
+7 ;
GETOT ;
+1 ; Get visit location subtotal
+2 SET $PIECE(BARLTOT,U)=$PIECE($GET(BARLTOT),U)+$PIECE(BARHOLD,U)
+3 SET $PIECE(BARLTOT,U,2)=$PIECE($GET(BARLTOT),U,2)+$PIECE(BARHOLD,U,2)
+4 SET $PIECE(BARLTOT,U,3)=$PIECE($GET(BARLTOT),U,3)+$PIECE(BARHOLD,U,3)
+5 ; Get report total
+6 SET $PIECE(BARTOT,U)=$PIECE($GET(BARTOT),U)+$PIECE(BARHOLD,U)
+7 SET $PIECE(BARTOT,U,2)=$PIECE($GET(BARTOT),U,2)+$PIECE(BARHOLD,U,2)
+8 SET $PIECE(BARTOT,U,3)=$PIECE($GET(BARTOT),U,3)+$PIECE(BARHOLD,U,3)
+9 QUIT
+10 ; ********************************************************************
+11 ;
LOCTOT ;
+1 IF '+BARASK
WRITE !
+2 XECUTE BARDASH
+3 WRITE !?2,"VISIT LOC TOTAL"
+4 WRITE ?18,$JUSTIFY($PIECE(BARLTOT,U),4)
+5 WRITE ?24,$JUSTIFY($FNUMBER($PIECE(BARLTOT,U,2),",",2),15)
+6 WRITE ?41,$JUSTIFY($FNUMBER($PIECE(BARLTOT,U,3),",",2),15)
+7 QUIT
+8 ; ********************************************************************
+9 ;
TOTAL ;
+1 XECUTE BAREQUAL
+2 WRITE !?5,"REPORT TOTAL"
+3 WRITE ?18,$JUSTIFY($PIECE(BARTOT,U),4)
+4 WRITE ?24,$JUSTIFY($FNUMBER($PIECE(BARTOT,U,2),",",2),15)
+5 WRITE ?41,$JUSTIFY($FNUMBER($PIECE(BARTOT,U,3),",",2),15)
+6 QUIT
+7 ; ********************************************************************
+8 ; ********************************************************************
+9 ;
PRTDET ;
+1 ; Print Detail Report
+2 DO HDB^BARRPSRB
+3 SET BARVIS=""
+4 FOR
SET BARVIS=$ORDER(^TMP($JOB,"BAR-PRP",BARVIS))
IF BARVIS=""
QUIT
DO LOC
IF $GET(BAR("F1"))
QUIT
+5 DO TOTAL
+6 QUIT
+7 ; ********************************************************************
+8 ;
LOC ;
+1 ; For each visit location do (clinic/visit type)
+2 KILL BARLTOT
+3 WRITE !,"VISIT LOCATION: ",BARVIS,!
+4 SET BARDOS=0
+5 FOR
SET BARDOS=$ORDER(^TMP($JOB,"BAR-PRP",BARVIS,BARDOS))
IF '+BARDOS
QUIT
Begin DoDot:1
+6 SET BARHOLD=$GET(^TMP($JOB,"BAR-PRP",BARVIS,BARDOS))
+7 DO DETAIL
+8 DO GETOT
End DoDot:1
IF $GET(BAR("F1"))
QUIT
+9 DO LOCTOT
+10 QUIT
+11 ; ********************************************************************
+12 ;
PRTBATCH ;
+1 ; Print batch listing at end of report
+2 DO PAZ^BARRUTL
+3 IF $GET(BAR("F1"))
QUIT
+4 SET BAREQUAL="W !?31,""==============="",?47,""==============="",?63,""==============="""
+5 SET BATHDR=" ** BATCH LISTING **"
+6 SET BARLVL=$ORDER(BAR("HD",99),-1)
+7 SET BAR("HD",BARLVL)=BAR("HD",BARLVL)_BATHDR
+8 SET BAR("COL")="W !,""COLLECTION BATCHES"",?32,""BATCHED AMOUNT"",?49,""POSTED AMOUNT"",?63,""UNPOSTED AMOUNT"""
+9 DO HDB^BARRPSRB
+10 SET BARBNAME=""
+11 FOR
SET BARBNAME=$ORDER(BARB(BARBNAME))
IF BARBNAME=""
QUIT
DO BATCHDET
IF $GET(BAR("F1"))
QUIT
+12 XECUTE BAREQUAL
+13 WRITE !?20,"TOTALS"
+14 WRITE ?31,$JUSTIFY($FNUMBER($PIECE(BARBTOT,U),",",2),15)
+15 WRITE ?47,$JUSTIFY($FNUMBER($PIECE(BARBTOT,U,2),",",2),15)
+16 WRITE ?63,$JUSTIFY($FNUMBER($PIECE(BARBTOT,U,3),",",2),15)
+17 QUIT
+18 ; ********************************************************************
+19 ;
BATCHDET ;
+1 ; Write batch detail lines
+2 SET BARHOLD=$GET(BARB(BARBNAME))
+3 WRITE !,$EXTRACT(BARBNAME,1,30)
+4 WRITE ?31,$JUSTIFY($FNUMBER($PIECE(BARHOLD,U),",",2),15)
+5 WRITE ?47,$JUSTIFY($FNUMBER($PIECE(BARHOLD,U,2),",",2),15)
+6 WRITE ?63,$JUSTIFY($FNUMBER($PIECE(BARHOLD,U,3),",",2),15)
+7 QUIT
