Routine: BARRPRP2

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

 ; *********************************************************************

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")

 ; ********************************************************************

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

 ; ********************************************************************

 ; ********************************************************************

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

 ; ********************************************************************

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

 ; ********************************************************************

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 !

 ; ********************************************************************

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

 ; ********************************************************************

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)

 ; ********************************************************************

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)

 ; ********************************************************************

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)

 ; ********************************************************************

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)

 ; ********************************************************************

 ; ********************************************************************

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

 ; ********************************************************************

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

 ; ********************************************************************

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)

 ; ********************************************************************

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)

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

BARRPRP2.m