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
Q
; *********************************************************************
;
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
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
Q
; ********************************************************************
;
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
Q
; ********************************************************************
;
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
Q
; ********************************************************************
;
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
Q
; *********************************************************************
;
STNDTOT ;
; Report Totals (Standard format)
Q:$G(BAR("F1"))
W !,BAREQUAL,!
S BARTMP=$G(^TMP($J,"BAR-PSR"))
W "***** REPORT TOTAL"
D STNDLINE
Q
; *********************************************************************
; *********************************************************************
;
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
Q
; ********************************************************************
;
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
Q
; ********************************************************************
;
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
Q
; ********************************************************************
; ********************************************************************
;
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
Q
; ********************************************************************
;
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
Q
; ********************************************************************
;
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
Q
; ********************************************************************
;
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
Q
; ********************************************************************
; ********************************************************************
;
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
Q
; ********************************************************************
;
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
Q
; ********************************************************************
;
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
Q
; ********************************************************************
;
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
Q
; ********************************************************************
;
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
Q
; ********************************************************************
;
SUMTOT ;
; Report totals (summary, detail, bill)
Q:$G(BAR("F1"))
S BARTMP=$G(^TMP($J,"BAR-PSRT"))
W BAREQUAL,!
W "***** REPORT Total"
D STNDLINE
Q
; ********************************************************************
;
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
Q
; ********************************************************************
;
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
Q
; ********************************************************************
;
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 !
Q
; ********************************************************************
;
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
Q
; ********************************************************************
; ********************************************************************
;
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"),!
Q
; ********************************************************************
;
XIT ;
K ^TMP($J,"BAR-PSR")
K ^TMP($J,"BAR-PSRT")
Q
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
