Routine: BARRPSRB

BARRPSRB ; IHS/SD/LSL - Period Summary Report Print ; 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/ASDS/LSL - 02/27/03 - V1.7 Patch 1

 ;     Routine created.  Called from BARRPSRA

 ;     PRINT^BARRASMA - Print report

 ; IHS/SD/LSL - 08/01/03 - V1.7 Patch 2

 ;     Add call to PSR^EISS for print of summary data

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

PRINT ; EP

 ; Print reports

 F I=1:1:4 K BAR(I)

 F I=1:1:5 K BAR("SUB"_I)

 S BAR("PG")=0

 S BARDASH="                     --------------- -------------- -------------- -------------"

 S BAREQUAL="                    =============== ============== ============== ============="

 S BAR("COL")="W !,BARY(""STCR"",""NM""),?25,""Billed Amt"",?43,""Payment"",?55,""Adjustment"",?72,""Refund"""

 I ",1,2,3,4,"[(","_BARY("STCR")_",") D STANDARD

 I $G(BAR("F1")) D XIT Q

 I $G(BARY("RTYP"))=1 D SUMMARY

 I $G(BAR("F1")) D XIT Q

 I $G(BARY("RTYP"))=2 D DETAIL

 I $G(BAR("F1")) D XIT Q

 I $G(BARY("RTYP"))=3 D BILL

 I $G(BAR("F1")) D XIT Q

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

STANDARD ;

 ; Print report if user selected SORT CRITERIA a/r account, visit, or

 ; clinic

 D HDB

 I '$D(^TMP($J,"BAR-PSR")) D  Q           ; No data - quit

 . W !!!!!?25,"*** NO DATA TO PRINT ***"

 . D EOP^BARUTL(0)

 S BARHOLD("SUB1")=$O(^TMP($J,"BAR-PSR",""))

 S BAR("SUB1")=""

 F  S BAR("SUB1")=$O(^TMP($J,"BAR-PSR",BAR("SUB1"))) Q:BAR("SUB1")=""  D STNDLOC Q:$G(BAR("F1"))

 D STNDTOT

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

STNDLOC ;

 ; For each Visit Location (Standard Format) Do...

 I BAR("SUB1")'=BARHOLD("SUB1") D HD

 Q:$G(BAR("F1"))

 S BARHOLD("SUB1")=BAR("SUB1")

 I '$D(BARY("LOC")) W !,"*** VISIT Location: ",BAR("SUB1"),!

 S BAR("SUB2")=""

 F  S BAR("SUB2")=$O(^TMP($J,"BAR-PSR",BAR("SUB1"),BAR("SUB2"))) Q:BAR("SUB2")=""  D STNDDET Q:$G(BAR("F1"))

 D STNDLTOT

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

STNDDET ;

 ; For each Clinic/Visit Type/AR Account/Dsch Svc (Standard) do...

 I $Y>(IOSL-5) D HD Q:$G(BAR("F1"))

 S BARTMP=$G(^TMP($J,"BAR-PSR",BAR("SUB1"),BAR("SUB2")))

 S BARNAME=BAR("SUB2")

 W !,$E(BARNAME,1,19)            ; clinic/vis typ/A/R acct/discharge svc

 D STNDLINE

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

STNDLTOT ;

 ; Visit Location Totals (Standard format)

 Q:$G(BAR("F1"))

 W !,BARDASH,!

 S BARTMP=$G(^TMP($J,"BAR-PSR",BAR("SUB1")))

 W "*** VISIT Loc Total"

 D STNDLINE

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

STNDTOT ;

 ; Report Totals (Standard format)

 Q:$G(BAR("F1"))

 W !,BAREQUAL,!

 S BARTMP=$G(^TMP($J,"BAR-PSR"))

 W "***** REPORT TOTAL"

 D STNDLINE

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

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

SUMMARY ;

 ; Print report if user selected SORT CRITERIA Billing Entity or

 ; Allowance Category and Report Type w/o payers

 D HDB

 I '$D(^TMP($J,"BAR-PSRT")) D  Q           ; No data - quit

 . W !!!!!?25,"*** NO DATA TO PRINT ***"

 . D EOP^BARUTL(0)

 S BARHOLD("SUB1")=$O(^TMP($J,"BAR-PSRT",""))

 S BAR("SUB1")=""

 F  S BAR("SUB1")=$O(^TMP($J,"BAR-PSRT",BAR("SUB1"))) Q:BAR("SUB1")=""  D SUMLOC  Q:$G(BAR("F1"))

W !

 D SUMTOT

 I BARY("STCR")=5,'$D(BARY("ALL")) D PSR^BAREISS

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

SUMLOC ;

 ; For each visit location (Summary format) do...

 I BAR("SUB1")'=BARHOLD("SUB1") D HD

 Q:$G(BAR("F1"))

 S BARHOLD("SUB1")=BAR("SUB1")

 I '$D(BARY("LOC")) W !,"*** VISIT Location: ",BAR("SUB1"),!

 S BAR("SUB3")=""

 F  S BAR("SUB3")=$O(^TMP($J,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"))) Q:BAR("SUB3")=""  D SUMDET Q:$G(BAR("F1"))

W !

 D SUMLTOT

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

SUMDET ;

 ; For each Billing Entity/Allowance category (summary) do...

 I $Y>(IOSL-5) D HD Q:$G(BAR("F1"))

 S BARTMP=$G(^TMP($J,"BAR-PSRT",BAR("SUB1"),BAR("SUB3")))

 W !,$E(BAR("SUB3"),1,19)

 D STNDLINE

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

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

DETAIL ;

 ; Print report if user selected SORT CRITERIA Billing Entity or

 ; Allowance Category and Report Type with payers

 D HDB

 I '$D(^TMP($J,"BAR-PSRT")) D  Q           ; No data - quit

 . W !!!!!?25,"*** NO DATA TO PRINT ***"

 . D EOP^BARUTL(0)

 S BARHOLD("SUB1")=$O(^TMP($J,"BAR-PSRT",""))

 S BAR("SUB1")=""

 F  S BAR("SUB1")=$O(^TMP($J,"BAR-PSRT",BAR("SUB1"))) Q:BAR("SUB1")=""  D DETLOC  Q:$G(BAR("F1"))

W !

 D SUMTOT

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

DETLOC ;

 ; For each visit location (Detail format) do...

 I BAR("SUB1")'=BARHOLD("SUB1") D HD

 Q:$G(BAR("F1"))

 S BARHOLD("SUB1")=BAR("SUB1")

 I '$D(BARY("LOC")) W !,"*** VISIT Location: ",BAR("SUB1"),!

 S BAR("SUB3")=""

 F  S BAR("SUB3")=$O(^TMP($J,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"))) Q:BAR("SUB3")=""  D DETBEAL Q:$G(BAR("F1"))

 D SUMLTOT

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

DETBEAL ;

 ; For each Billing Entity/Allowance category (Detail format) do...

 W !,BAR("SUB3")

 S BAR("SUB4")=""

 F  S BAR("SUB4")=$O(^TMP($J,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"))) Q:BAR("SUB4")=""  D DETDET Q:$G(BAR("F1"))

W !

 D BEALTOT

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

DETDET ;

 ; For each A/R Account (Detail Format) do...

 I $Y>(IOSL-5) D HD Q:$G(BAR("F1"))

 S BARTMP=$G(^TMP($J,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4")))

 W !?3,$E(BAR("SUB4"),1,15)

 D STNDLINE

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

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

BILL ;

 ; Summary / by payer / By Bill

 ; Print report if user selected SORT CRITERIA Billing Entity or

 ; Allowance Category and Report Type with payers AND bills

 D HDB

 I '$D(^TMP($J,"BAR-PSRT")) D  Q           ; No data - quit

 . W !!!!!?25,"*** NO DATA TO PRINT ***"

 . D EOP^BARUTL(0)

 S BARHOLD("SUB1")=$O(^TMP($J,"BAR-PSRT",""))

 S BAR("SUB1")=""

 F  S BAR("SUB1")=$O(^TMP($J,"BAR-PSRT",BAR("SUB1"))) Q:BAR("SUB1")=""  D BILLLOC  Q:$G(BAR("F1"))

W !

 D SUMTOT

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

BILLLOC ;

 ; For each visit location (Detail format) do...

 I BAR("SUB1")'=BARHOLD("SUB1") D HD

 Q:$G(BAR("F1"))

 S BARHOLD("SUB1")=BAR("SUB1")

 I '$D(BARY("LOC")) W !,"*** VISIT Location: ",BAR("SUB1"),!

 S BAR("SUB3")=""

 F  S BAR("SUB3")=$O(^TMP($J,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"))) Q:BAR("SUB3")=""  D BILLBEAL Q:$G(BAR("F1"))

W !

 D SUMLTOT

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

BILLBEAL ;

 ; For each Billing Entity/Allowance category (Detail format) do...

 W $$EN^BARVDF("HIN")

 W !,$$CJ^XLFSTR(BAR("SUB3"),IOM),!

 W $$EN^BARVDF("HIF")

 S BAR("SUB4")=""

 F  S BAR("SUB4")=$O(^TMP($J,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"))) Q:BAR("SUB4")=""  D BILLACCT Q:$G(BAR("F1"))

 D BEALTOT

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

BILLACCT ;

 ; For each A/R Account (Bill detail) do ...

 W !?3,BAR("SUB4")

 S BAR("SUB5")=""

 F  S BAR("SUB5")=$O(^TMP($J,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"),BAR("SUB5"))) Q:BAR("SUB5")=""  D BILLDET Q:$G(BAR("F1"))

 D ACCTTOT

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

BILLDET ;

 ; For each Bill (Bill Format) do...

 I $Y>(IOSL-5) D HD Q:$G(BAR("F1"))

 S BARTMP=$G(^TMP($J,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"),BAR("SUB5")))

 W !?6,$E(BAR("SUB5"),1,15)

 D STNDLINE

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

SUMTOT ;

 ; Report totals (summary, detail, bill)

 Q:$G(BAR("F1"))

 S BARTMP=$G(^TMP($J,"BAR-PSRT"))

 W BAREQUAL,!

 W "***** REPORT Total"

 D STNDLINE

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

SUMLTOT ;

 ; Visit Location totals (summary, detail, bill)

 Q:$G(BAR("F1"))

 S BARTMP=$G(^TMP($J,"BAR-PSRT",BAR("SUB1")))

 W BARDASH,!

 W "*** VISIT Loc Total"

 D STNDLINE

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

BEALTOT ;

 ; Billing Entity / Allowance Category totals (detail, bill)

 Q:$G(BAR("F1"))

 S BARTMP=$G(^TMP($J,"BAR-PSRT",BAR("SUB1"),BAR("SUB3")))

 W BARDASH,!

 I BARY("STCR")=5 W " ** Allow Cat Total"

 I BARY("STCR")=6 W " ** Bill Entity Total"

 I BARY("STCR")=7 W " ** Ins Type Total"

 D STNDLINE

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

ACCTTOT ;

 ; A/R  Account totals (bill)

 Q:$G(BAR("F1"))

 S BARTMP=$G(^TMP($J,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4")))

 W !,BARDASH,!

 W "  * A/R Acct Total"

 D STNDLINE

W !

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

STNDLINE ;

 W ?20,$J($FN($P(BARTMP,U),",",2),15)      ; Amount billed

 W ?36,$J($FN($P(BARTMP,U,2),",",2),14)      ; Payments

 W ?51,$J($FN($P(BARTMP,U,3),",",2),14)      ; Adjustments

 W ?66,$J($FN($P(BARTMP,U,4),",",2),13)      ; Refunds

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

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

HD ; EP

 D PAZ^BARRUTL

 I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S BAR("F1")=1 Q

 ; -------------------------------

HDB ; EP

 ; Page and column header

 S BAR("PG")=BAR("PG")+1

 S BAR("I")=""

 D WHD^BARRHD                   ; Report header

 X BAR("COL")

 S $P(BAR("DASH"),"=",$S($D(BAR(133)):132,1:81))=""

 W !,BAR("DASH"),!

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

XIT ;

 K ^TMP($J,"BAR-PSR")

 K ^TMP($J,"BAR-PSRT")

BARRPSRB  ; IHS/SD/LSL - Period Summary Report Print ; 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/ASDS/LSL - 02/27/03 - V1.7 Patch 1

 +4       ;     Routine created.  Called from BARRPSRA

 +5       ;     PRINT^BARRASMA - Print report

 +6       ;

 +7       ; IHS/SD/LSL - 08/01/03 - V1.7 Patch 2

 +8       ;     Add call to PSR^EISS for print of summary data

 +9        QUIT

 +10      ; *********************************************************************

 +11      ;

PRINT     ; EP

 +1       ; Print reports

 +2        FOR I=1:1:4

               KILL BAR(I)

 +3        FOR I=1:1:5

               KILL BAR("SUB"_I)

 +4        SET BAR("PG")=0

 +5        SET BARDASH="                     --------------- -------------- -------------- -------------"

 +6        SET BAREQUAL="                    =============== ============== ============== ============="

 +7        SET BAR("COL")="W !,BARY(""STCR"",""NM""),?25,""Billed Amt"",?43,""Payment"",?55,""Adjustment"",?72,""Refund"""

 +8        IF ",1,2,3,4,"[(","_BARY("STCR")_",")

               DO STANDARD

 +9        IF $GET(BAR("F1"))

               DO XIT

               QUIT

 +10       IF $GET(BARY("RTYP"))=1

               DO SUMMARY

 +11       IF $GET(BAR("F1"))

               DO XIT

               QUIT

 +12       IF $GET(BARY("RTYP"))=2

               DO DETAIL

 +13       IF $GET(BAR("F1"))

               DO XIT

               QUIT

 +14       IF $GET(BARY("RTYP"))=3

               DO BILL

 +15       IF $GET(BAR("F1"))

               DO XIT

               QUIT

 +16       QUIT

 +17      ; *********************************************************************

 +18      ;

STANDARD  ;

 +1       ; Print report if user selected SORT CRITERIA a/r account, visit, or

 +2       ; clinic

 +3       ;

 +4        DO HDB

 +5       ; No data - quit

           IF '$DATA(^TMP($JOB,"BAR-PSR"))

               Begin DoDot:1

 +6                WRITE !!!!!?25,"*** NO DATA TO PRINT ***"

 +7                DO EOP^BARUTL(0)

               End DoDot:1

               QUIT

 +8       ;

 +9        SET BARHOLD("SUB1")=$ORDER(^TMP($JOB,"BAR-PSR",""))

 +10       SET BAR("SUB1")=""

 +11       FOR

               SET BAR("SUB1")=$ORDER(^TMP($JOB,"BAR-PSR",BAR("SUB1")))

               IF BAR("SUB1")=""

                   QUIT

               DO STNDLOC

               IF $GET(BAR("F1"))

                   QUIT

 +12       DO STNDTOT

 +13       QUIT

 +14      ; ********************************************************************

 +15      ;

STNDLOC   ;

 +1       ; For each Visit Location (Standard Format) Do...

 +2        IF BAR("SUB1")'=BARHOLD("SUB1")

               DO HD

 +3        IF $GET(BAR("F1"))

               QUIT

 +4        SET BARHOLD("SUB1")=BAR("SUB1")

 +5        IF '$DATA(BARY("LOC"))

               WRITE !,"*** VISIT Location: ",BAR("SUB1"),!

 +6        SET BAR("SUB2")=""

 +7        FOR

               SET BAR("SUB2")=$ORDER(^TMP($JOB,"BAR-PSR",BAR("SUB1"),BAR("SUB2")))

               IF BAR("SUB2")=""

                   QUIT

               DO STNDDET

               IF $GET(BAR("F1"))

                   QUIT

 +8        DO STNDLTOT

 +9        QUIT

 +10      ; ********************************************************************

 +11      ;

STNDDET   ;

 +1       ; For each Clinic/Visit Type/AR Account/Dsch Svc (Standard) do...

 +2        IF $Y>(IOSL-5)

               DO HD

               IF $GET(BAR("F1"))

                   QUIT

 +3        SET BARTMP=$GET(^TMP($JOB,"BAR-PSR",BAR("SUB1"),BAR("SUB2")))

 +4        SET BARNAME=BAR("SUB2")

 +5       ; clinic/vis typ/A/R acct/discharge svc

           WRITE !,$EXTRACT(BARNAME,1,19)

 +6        DO STNDLINE

 +7        QUIT

 +8       ; ********************************************************************

 +9       ;

STNDLTOT  ;

 +1       ; Visit Location Totals (Standard format)

 +2        IF $GET(BAR("F1"))

               QUIT

 +3        WRITE !,BARDASH,!

 +4        SET BARTMP=$GET(^TMP($JOB,"BAR-PSR",BAR("SUB1")))

 +5        WRITE "*** VISIT Loc Total"

 +6        DO STNDLINE

 +7        QUIT

 +8       ; *********************************************************************

 +9       ;

STNDTOT   ;

 +1       ; Report Totals (Standard format)

 +2        IF $GET(BAR("F1"))

               QUIT

 +3        WRITE !,BAREQUAL,!

 +4        SET BARTMP=$GET(^TMP($JOB,"BAR-PSR"))

 +5        WRITE "***** REPORT TOTAL"

 +6        DO STNDLINE

 +7        QUIT

 +8       ; *********************************************************************

 +9       ; *********************************************************************

 +10      ;

SUMMARY   ;

 +1       ; Print report if user selected SORT CRITERIA Billing Entity or

 +2       ; Allowance Category and Report Type w/o payers

 +3       ;

 +4        DO HDB

 +5       ; No data - quit

           IF '$DATA(^TMP($JOB,"BAR-PSRT"))

               Begin DoDot:1

 +6                WRITE !!!!!?25,"*** NO DATA TO PRINT ***"

 +7                DO EOP^BARUTL(0)

               End DoDot:1

               QUIT

 +8       ;

 +9        SET BARHOLD("SUB1")=$ORDER(^TMP($JOB,"BAR-PSRT",""))

 +10       SET BAR("SUB1")=""

 +11       FOR

               SET BAR("SUB1")=$ORDER(^TMP($JOB,"BAR-PSRT",BAR("SUB1")))

               IF BAR("SUB1")=""

                   QUIT

               DO SUMLOC

               IF $GET(BAR("F1"))

                   QUIT

 +12       WRITE !

 +13       DO SUMTOT

 +14       IF BARY("STCR")=5

               IF '$DATA(BARY("ALL"))

                   DO PSR^BAREISS

 +15       QUIT

 +16      ; ********************************************************************

 +17      ;

SUMLOC    ;

 +1       ; For each visit location (Summary format) do...

 +2        IF BAR("SUB1")'=BARHOLD("SUB1")

               DO HD

 +3        IF $GET(BAR("F1"))

               QUIT

 +4        SET BARHOLD("SUB1")=BAR("SUB1")

 +5        IF '$DATA(BARY("LOC"))

               WRITE !,"*** VISIT Location: ",BAR("SUB1"),!

 +6        SET BAR("SUB3")=""

 +7        FOR

               SET BAR("SUB3")=$ORDER(^TMP($JOB,"BAR-PSRT",BAR("SUB1"),BAR("SUB3")))

               IF BAR("SUB3")=""

                   QUIT

               DO SUMDET

               IF $GET(BAR("F1"))

                   QUIT

 +8        WRITE !

 +9        DO SUMLTOT

 +10       QUIT

 +11      ; ********************************************************************

 +12      ;

SUMDET    ;

 +1       ; For each Billing Entity/Allowance category (summary) do...

 +2        IF $Y>(IOSL-5)

               DO HD

               IF $GET(BAR("F1"))

                   QUIT

 +3        SET BARTMP=$GET(^TMP($JOB,"BAR-PSRT",BAR("SUB1"),BAR("SUB3")))

 +4        WRITE !,$EXTRACT(BAR("SUB3"),1,19)

 +5        DO STNDLINE

 +6        QUIT

 +7       ; ********************************************************************

 +8       ; ********************************************************************

 +9       ;

DETAIL    ;

 +1       ; Print report if user selected SORT CRITERIA Billing Entity or

 +2       ; Allowance Category and Report Type with payers

 +3        DO HDB

 +4       ; No data - quit

           IF '$DATA(^TMP($JOB,"BAR-PSRT"))

               Begin DoDot:1

 +5                WRITE !!!!!?25,"*** NO DATA TO PRINT ***"

 +6                DO EOP^BARUTL(0)

               End DoDot:1

               QUIT

 +7       ;

 +8        SET BARHOLD("SUB1")=$ORDER(^TMP($JOB,"BAR-PSRT",""))

 +9        SET BAR("SUB1")=""

 +10       FOR

               SET BAR("SUB1")=$ORDER(^TMP($JOB,"BAR-PSRT",BAR("SUB1")))

               IF BAR("SUB1")=""

                   QUIT

               DO DETLOC

               IF $GET(BAR("F1"))

                   QUIT

 +11       WRITE !

 +12       DO SUMTOT

 +13       QUIT

 +14      ; ********************************************************************

 +15      ;

DETLOC    ;

 +1       ; For each visit location (Detail format) do...

 +2        IF BAR("SUB1")'=BARHOLD("SUB1")

               DO HD

 +3        IF $GET(BAR("F1"))

               QUIT

 +4        SET BARHOLD("SUB1")=BAR("SUB1")

 +5        IF '$DATA(BARY("LOC"))

               WRITE !,"*** VISIT Location: ",BAR("SUB1"),!

 +6        SET BAR("SUB3")=""

 +7        FOR

               SET BAR("SUB3")=$ORDER(^TMP($JOB,"BAR-PSRT",BAR("SUB1"),BAR("SUB3")))

               IF BAR("SUB3")=""

                   QUIT

               DO DETBEAL

               IF $GET(BAR("F1"))

                   QUIT

 +8        DO SUMLTOT

 +9        QUIT

 +10      ; ********************************************************************

 +11      ;

DETBEAL   ;

 +1       ; For each Billing Entity/Allowance category (Detail format) do...

 +2        WRITE !,BAR("SUB3")

 +3        SET BAR("SUB4")=""

 +4        FOR

               SET BAR("SUB4")=$ORDER(^TMP($JOB,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4")))

               IF BAR("SUB4")=""

                   QUIT

               DO DETDET

               IF $GET(BAR("F1"))

                   QUIT

 +5        WRITE !

 +6        DO BEALTOT

 +7        QUIT

 +8       ; ********************************************************************

 +9       ;

DETDET    ;

 +1       ; For each A/R Account (Detail Format) do...

 +2        IF $Y>(IOSL-5)

               DO HD

               IF $GET(BAR("F1"))

                   QUIT

 +3        SET BARTMP=$GET(^TMP($JOB,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4")))

 +4        WRITE !?3,$EXTRACT(BAR("SUB4"),1,15)

 +5        DO STNDLINE

 +6        QUIT

 +7       ; ********************************************************************

 +8       ; ********************************************************************

 +9       ;

BILL      ;

 +1       ; Summary / by payer / By Bill

 +2       ; Print report if user selected SORT CRITERIA Billing Entity or

 +3       ; Allowance Category and Report Type with payers AND bills

 +4        DO HDB

 +5       ; No data - quit

           IF '$DATA(^TMP($JOB,"BAR-PSRT"))

               Begin DoDot:1

 +6                WRITE !!!!!?25,"*** NO DATA TO PRINT ***"

 +7                DO EOP^BARUTL(0)

               End DoDot:1

               QUIT

 +8       ;

 +9        SET BARHOLD("SUB1")=$ORDER(^TMP($JOB,"BAR-PSRT",""))

 +10       SET BAR("SUB1")=""

 +11       FOR

               SET BAR("SUB1")=$ORDER(^TMP($JOB,"BAR-PSRT",BAR("SUB1")))

               IF BAR("SUB1")=""

                   QUIT

               DO BILLLOC

               IF $GET(BAR("F1"))

                   QUIT

 +12       WRITE !

 +13       DO SUMTOT

 +14       QUIT

 +15      ; ********************************************************************

 +16      ;

BILLLOC   ;

 +1       ; For each visit location (Detail format) do...

 +2        IF BAR("SUB1")'=BARHOLD("SUB1")

               DO HD

 +3        IF $GET(BAR("F1"))

               QUIT

 +4        SET BARHOLD("SUB1")=BAR("SUB1")

 +5        IF '$DATA(BARY("LOC"))

               WRITE !,"*** VISIT Location: ",BAR("SUB1"),!

 +6        SET BAR("SUB3")=""

 +7        FOR

               SET BAR("SUB3")=$ORDER(^TMP($JOB,"BAR-PSRT",BAR("SUB1"),BAR("SUB3")))

               IF BAR("SUB3")=""

                   QUIT

               DO BILLBEAL

               IF $GET(BAR("F1"))

                   QUIT

 +8        WRITE !

 +9        DO SUMLTOT

 +10       QUIT

 +11      ; ********************************************************************

 +12      ;

BILLBEAL  ;

 +1       ; For each Billing Entity/Allowance category (Detail format) do...

 +2        WRITE $$EN^BARVDF("HIN")

 +3        WRITE !,$$CJ^XLFSTR(BAR("SUB3"),IOM),!

 +4        WRITE $$EN^BARVDF("HIF")

 +5        SET BAR("SUB4")=""

 +6        FOR

               SET BAR("SUB4")=$ORDER(^TMP($JOB,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4")))

               IF BAR("SUB4")=""

                   QUIT

               DO BILLACCT

               IF $GET(BAR("F1"))

                   QUIT

 +7        DO BEALTOT

 +8        QUIT

 +9       ; ********************************************************************

 +10      ;

BILLACCT  ;

 +1       ; For each A/R Account (Bill detail) do ...

 +2        WRITE !?3,BAR("SUB4")

 +3        SET BAR("SUB5")=""

 +4        FOR

               SET BAR("SUB5")=$ORDER(^TMP($JOB,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"),BAR("SUB5")))

               IF BAR("SUB5")=""

                   QUIT

               DO BILLDET

               IF $GET(BAR("F1"))

                   QUIT

 +5        DO ACCTTOT

 +6        QUIT

 +7       ; ********************************************************************

 +8       ;

BILLDET   ;

 +1       ; For each Bill (Bill Format) do...

 +2        IF $Y>(IOSL-5)

               DO HD

               IF $GET(BAR("F1"))

                   QUIT

 +3        SET BARTMP=$GET(^TMP($JOB,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"),BAR("SUB5")))

 +4        WRITE !?6,$EXTRACT(BAR("SUB5"),1,15)

 +5        DO STNDLINE

 +6        QUIT

 +7       ; ********************************************************************

 +8       ;

SUMTOT    ;

 +1       ; Report totals (summary, detail, bill)

 +2        IF $GET(BAR("F1"))

               QUIT

 +3        SET BARTMP=$GET(^TMP($JOB,"BAR-PSRT"))

 +4        WRITE BAREQUAL,!

 +5        WRITE "***** REPORT Total"

 +6        DO STNDLINE

 +7        QUIT

 +8       ; ********************************************************************

 +9       ;

SUMLTOT   ;

 +1       ; Visit Location totals (summary, detail, bill)

 +2        IF $GET(BAR("F1"))

               QUIT

 +3        SET BARTMP=$GET(^TMP($JOB,"BAR-PSRT",BAR("SUB1")))

 +4        WRITE BARDASH,!

 +5        WRITE "*** VISIT Loc Total"

 +6        DO STNDLINE

 +7        QUIT

 +8       ; ********************************************************************

 +9       ;

BEALTOT   ;

 +1       ; Billing Entity / Allowance Category totals (detail, bill)

 +2        IF $GET(BAR("F1"))

               QUIT

 +3        SET BARTMP=$GET(^TMP($JOB,"BAR-PSRT",BAR("SUB1"),BAR("SUB3")))

 +4        WRITE BARDASH,!

 +5        IF BARY("STCR")=5

               WRITE " ** Allow Cat Total"

 +6        IF BARY("STCR")=6

               WRITE " ** Bill Entity Total"

 +7        IF BARY("STCR")=7

               WRITE " ** Ins Type Total"

 +8        DO STNDLINE

 +9        QUIT

 +10      ; ********************************************************************

 +11      ;

ACCTTOT   ;

 +1       ; A/R  Account totals (bill)

 +2        IF $GET(BAR("F1"))

               QUIT

 +3        SET BARTMP=$GET(^TMP($JOB,"BAR-PSRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4")))

 +4        WRITE !,BARDASH,!

 +5        WRITE "  * A/R Acct Total"

 +6        DO STNDLINE

 +7        WRITE !

 +8        QUIT

 +9       ; ********************************************************************

 +10      ;

STNDLINE  ;

 +1       ; Amount billed

           WRITE ?20,$JUSTIFY($FNUMBER($PIECE(BARTMP,U),",",2),15)

 +2       ; Payments

           WRITE ?36,$JUSTIFY($FNUMBER($PIECE(BARTMP,U,2),",",2),14)

 +3       ; Adjustments

           WRITE ?51,$JUSTIFY($FNUMBER($PIECE(BARTMP,U,3),",",2),14)

 +4       ; Refunds

           WRITE ?66,$JUSTIFY($FNUMBER($PIECE(BARTMP,U,4),",",2),13)

 +5        QUIT

 +6       ; ********************************************************************

 +7       ; ********************************************************************

 +8       ;

HD        ; EP

 +1        DO PAZ^BARRUTL

 +2        IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)

               SET BAR("F1")=1

               QUIT

 +3       ; -------------------------------

 +4       ;

HDB       ; EP

 +1       ; Page and column header

 +2        SET BAR("PG")=BAR("PG")+1

 +3        SET BAR("I")=""

 +4       ; Report header

           DO WHD^BARRHD

 +5        XECUTE BAR("COL")

 +6        SET $PIECE(BAR("DASH"),"=",$SELECT($DATA(BAR(133)):132,1:81))=""

 +7        WRITE !,BAR("DASH"),!

 +8        QUIT

 +9       ; ********************************************************************

 +10      ;

XIT       ;

 +1        KILL ^TMP($JOB,"BAR-PSR")

 +2        KILL ^TMP($JOB,"BAR-PSRT")

 +3        QUIT

BARRPSRB.m