BARRASMB ; IHS/SD/LSL - Age Summary Report Print Logic ;08/20/2008
;;1.8;IHS ACCOUNTS RECEIVABLE;**7,28**;OCT 26, 2005;Build 92
; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892
;IHS/ASDS/LSL - 11/24/03 - Routine created
; Called from BARRASM
; PRINT^BARRASMA - Print report
; Split from BARRASMA in V1.7 Patch 4 as BARRASMA became too large
;
;IHS/SD/LSL - 02/20/03 - V1.7 Patch 1 - Added DISCHARGE SERVICE sort and report. Add time run to report
; headers. (While still BARRASMA)
;IHS/SD/LSL - 08/01/03 - V1.7 Patch 2 - Add call to ASM^BAREISS to print of summary data (While still BARRASMA)
;IHS/SD/LSL - 11/24/03 - V1.7 Patch 4 - Add Visit Location Sort level to accomodate EISS
;
;IHS/SD/SDR 1.8*28 CR8350 HEAT295594 - Made call for EISS report conditional on BARA. BARA is set when running the USM report.
; we don't want the EISS run if running the USM report.
Q
; *********************************************************************
PRINT ; EP
; Print reports
F I=1:1:6 K BAR(I)
K BAR("SUB0")
K BAR("SUB1"),BAR("SUB2"),BAR("SUB3"),BARTMP,BARTMPS,BARTMPS2,BARNAME
S BAR("PG")=0
S BARDASH=" --------- --------- --------- --------- --------- ----------"
S BAREQUAL=" ========= ========= ========= ========= ========= =========="
S BAR("COL")="W !,BARY(""STCR"",""NM""),?22,""CURRENT"",?34,""31-60"",?44,""61-90"",?53,""91-120"",?65,""120+"",?73,""BALANCE"""
I ",1,2,3,4,"[(","_BARY("STCR")_",") D STANDARD
Q:$G(BAR("F1"))
I $G(BARY("RTYP"))=1 D SUMMARY
Q:$G(BAR("F1"))
I $G(BARY("RTYP"))=2 D DETAIL
Q:$G(BAR("F1"))
I $G(BARY("RTYP"))=3 D BILL
Q:$G(BAR("F1"))
Q
; *********************************************************************
;
STANDARD ;
; Print report if user selected SORT CRITERIA a/r account, visit, or
; clinic
;
D HDB ; Page and column header
I '$D(^TMP($J,"BAR-ASM")) D Q ; No data - quit
.W !!!!!?25,"*** NO DATA TO PRINT ***"
.;D EOP^BARUTL(0) ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594 -NOW WANT PAUSE IHS/DIT/CPC - 20180502 CR8350
.I '$D(BARA),(XQY0'["UFMS") D EOP^BARUTL(0) ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594 -NOW WANT PAUSE IHS/DIT/CPC - 20180502 CR8350
S BARHOLD("SUB0")=$O(^TMP($J,"BAR-ASM",""))
S BAR("SUB0")=""
F S BAR("SUB0")=$O(^TMP($J,"BAR-ASM",BAR("SUB0"))) Q:BAR("SUB0")="" D Q:$G(BAR("F1"))
.I BARHOLD("SUB0")'=BAR("SUB0") D HD
.Q:$G(BAR("F1"))
.S BARHOLD("SUB0")=BAR("SUB0")
.I '$D(BARY("LOC")) W !,"*** VISIT Location: ",BAR("SUB0"),!
.S BAR("SUB1")=""
.F S BAR("SUB1")=$O(^TMP($J,"BAR-ASM",BAR("SUB0"),BAR("SUB1"))) Q:BAR("SUB1")="" D Q:$G(BAR("F1"))
..I $Y>(IOSL-5),'$D(BARA),(XQY0'["UFMS") D EOP^BARUTL(0) D HD Q:$G(BAR("F1")) ;-NO PAUSE IHS/DIT/CPC - 20180502 CR8350
..S BARTMP=$G(^TMP($J,"BAR-ASM",BAR("SUB0"),BAR("SUB1")))
..S BARNAME=BAR("SUB1")
..W !,$E(BARNAME,1,19) ; clinic/vis typ/A/R acct/discharge svc
..W ?20,$J($P(BARTMP,U),9,2) ; CURRENT
..W ?30,$J($P(BARTMP,U,2),9,2) ; 31-60
..W ?40,$J($P(BARTMP,U,3),9,2) ; 61-90
..W ?50,$J($P(BARTMP,U,4),9,2) ; 90-120
..W ?60,$J($P(BARTMP,U,5),9,2) ; 120+
..W ?70,$J($P(BARTMP,U,6),10,2) ; BALANCE
.;
.; Visit Location Totals
.Q:$G(BAR("F1"))
.W !,BARDASH
.S BARTMP=$G(^TMP($J,"BAR-ASM",BAR("SUB0")))
.W !,"*** VISIT loc Total"
.W ?20,$J($P(BARTMP,U),9,2) ; CURRENT
.W ?30,$J($P(BARTMP,U,2),9,2) ; 31-60
.W ?40,$J($P(BARTMP,U,3),9,2) ; 61-90
.W ?50,$J($P(BARTMP,U,4),9,2) ; 90-120
.W ?60,$J($P(BARTMP,U,5),9,2) ; 120+
.W ?70,$J($P(BARTMP,U,6),10,2) ; BALANCE
Q:$G(BAR("F1"))
;
; Report Totals
W !,BAREQUAL
S BARTMP=$G(^TMP($J,"BAR-ASM"))
W !?20,$J($P(BARTMP,U),9,2) ; CURRENT
W ?30,$J($P(BARTMP,U,2),9,2) ; 31-60
W ?40,$J($P(BARTMP,U,3),9,2) ; 61-90
W ?50,$J($P(BARTMP,U,4),9,2) ; 90-120
W ?60,$J($P(BARTMP,U,5),9,2) ; 120+
W ?70,$J($P(BARTMP,U,6),10,2) ; BALANCE
;D EOP^BARUTL(0) ;-NOW WANT PAUSE IHS/DIT/CPC - 20180502 CR8350
I '$D(BARA),(XQY0'["UFMS") D EOP^BARUTL(0) ;If not USM Pause IHS/DIT/CPC - 20180502 BAR*1.8*28 CR8350
Q
; *********************************************************************
;
SUMMARY ;
; Print report if user selected SORT CRITERIA Billing Entity or
; Allowance Category and Report Type w/o payers
;
D HDB ; Page and column header
I '$D(^TMP($J,"BAR-ASMT")) D Q ; No data - quit
.W !!!!!?25,"*** NO DATA TO PRINT ***"
.;D EOP^BARUTL(0) ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594 -NOW WANT PAUSE IHS/DIT/CPC - 20180502 CR8350
.I '$D(BARA),(XQY0'["UFMS") D EOP^BARUTL(0) ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594 -NOW WANT PAUSE IHS/DIT/CPC - 20180502 CR8350
S BARHOLD("SUB0")=$O(^TMP($J,"BAR-ASMT",""))
S BAR("SUB0")=""
F S BAR("SUB0")=$O(^TMP($J,"BAR-ASMT",BAR("SUB0"))) Q:BAR("SUB0")="" D Q:$G(BAR("F1"))
.I BAR("SUB0")'=BARHOLD("SUB0") D HD
.Q:$G(BAR("F1"))
.S BARHOLD("SUB0")=BAR("SUB0")
.I '$D(BARY("LOC")) W !,"*** VISIT Location: ",BAR("SUB0"),!
.S BAR("SUB1")=""
.F S BAR("SUB1")=$O(^TMP($J,"BAR-ASMT",BAR("SUB0"),BAR("SUB1"))) Q:BAR("SUB1")="" D Q:$G(BAR("F1"))
..I $Y>(IOSL-5) D HD Q:$G(BAR("F1"))
..S BARTMP=$G(^TMP($J,"BAR-ASMT",BAR("SUB0"),BAR("SUB1")))
..W !,$E(BAR("SUB1"),1,19) ; Billing Entity/Allowance Category/Insurer Type
..D SUM2
.Q:$G(BAR("F1"))
.S BARTMP=$G(^TMP($J,"BAR-ASMT",BAR("SUB0")))
.W !,BARDASH,!,"*** VISIT Loc Total"
.D SUM2
Q:$G(BAR("F1"))
W !
D TOTAL ; Report Totals
;I BARY("STCR")=5,'$D(BARY("ALL")) D ASM^BAREISS ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
I BARY("STCR")=5,'$D(BARY("ALL")),'$D(BARA) D ASM^BAREISS ;BARA is defined in the USM report; if started there, it shouldn't run the EISS report ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
;D EOP^BARUTL(0) ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594 -NOW WANT PAUSE IHS/DIT/CPC - 20180502 CR8350
I '$D(BARA),(XQY0'["UFMS") D EOP^BARUTL(0) ;If not USM Pause IHS/DIT/CPC - 20180502 BAR*1.8*28 CR8350
Q
; *********************************************************************
;
DETAIL ;
; Print report if user selected SORT CRITERIA Billing Entity or
; Allowance Category and Report Type with payers
;
D HDB ; Page and column header
I '$D(^TMP($J,"BAR-ASMT")) D Q ; No data - quit
.W !!!!!?25,"*** NO DATA TO PRINT ***"
.;D EOP^BARUTL(0) ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594 -NOW WANT PAUSE IHS/DIT/CPC - 20180502 CR8350
.I '$D(BARA),(XQY0'["UFMS") D EOP^BARUTL(0) D EOP^BARUTL(0) ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594 -NOW WANT PAUSE IHS/DIT/CPC - 20180502 CR8350
;
S BARHOLD("SUB0")=$O(^TMP($J,"BAR-ASMT",""))
S BAR("SUB0")=""
F S BAR("SUB0")=$O(^TMP($J,"BAR-ASMT",BAR("SUB0"))) Q:BAR("SUB0")="" D Q:$G(BAR("F1"))
.I BAR("SUB0")'=BARHOLD("SUB0") D HD
.Q:$G(BAR("F1"))
.S BARHOLD("SUB0")=BAR("SUB0")
.I '$D(BARY("LOC")) W !,"*** VISIT Location: ",BAR("SUB0"),!
.S BAR("SUB1")=""
.F S BAR("SUB1")=$O(^TMP($J,"BAR-ASMT",BAR("SUB0"),BAR("SUB1"))) Q:BAR("SUB1")="" D Q:$G(BAR("F1"))
..S BARTMP=$G(^TMP($J,"BAR-ASMT",BAR("SUB0"),BAR("SUB1")))
..W !,$E(BAR("SUB1"),1,19) ; Billing Entity/Allowance Category
..S BAR("SUB2")=""
..F S BAR("SUB2")=$O(^TMP($J,"BAR-ASMT",BAR("SUB0"),BAR("SUB1"),BAR("SUB2"))) Q:BAR("SUB2")="" D Q:$G(BAR("F1"))
...I $Y>(IOSL-5) D HD Q:$G(BAR("F1"))
...S BARTMPS=$G(^TMP($J,"BAR-ASMT",BAR("SUB0"),BAR("SUB1"),BAR("SUB2")))
...W !?1,$E(BAR("SUB2"),1,18) ; A/R Account
...D ACCOUNT
...Q:$G(BAR("F1"))
..Q:$G(BAR("F1"))
..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 SUM2 ; Subtotals by Billing Entity/Allowance Category
.Q:$G(BAR("F1"))
.S BARTMP=$G(^TMP($J,"BAR-ASMT",BAR("SUB0")))
.W !,BARDASH,!,"*** VISIT Loc Total"
.D SUM2
Q:$G(BAR("F1"))
W !
D TOTAL ; Report Totals
;D EOP^BARUTL(0) ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594 -NOW WANT PAUSE IHS/DIT/CPC - 20180502 CR8350
I '$D(BARA),(XQY0'["UFMS") D EOP^BARUTL(0) ;If not USM Pause IHS/DIT/CPC - 20180502 BAR*1.8*28 CR8350
Q
; ********************************************************************
;
BILL ;
; Print report if user selected SORT CRITERIA Billing Entity or
; Allowance Category and Report Type with payers AND bills
;
D HDB ; Page and column header
I '$D(^TMP($J,"BAR-ASMT")) D Q ; No data - quit
.W !!!!!?25,"*** NO DATA TO PRINT ***"
.;D EOP^BARUTL(0) ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
.I '$D(BARA),(XQY0'["UFMS") D EOP^BARUTL(0) ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594 - NO USM PAGE BREAKS IHS/DIT/CPC - 20180502
;
S BARHOLD("SUB0")=$O(^TMP($J,"BAR-ASMT",""))
S BAR("SUB0")=""
F S BAR("SUB0")=$O(^TMP($J,"BAR-ASMT",BAR("SUB0"))) Q:BAR("SUB0")="" D Q:$G(BAR("F1"))
.I BAR("SUB0")'=BARHOLD("SUB0") D HD
.Q:$G(BAR("F1"))
.S BARHOLD("SUB0")=BAR("SUB0")
.I '$D(BARY("LOC")) W !,"*** VISIT Location: ",BAR("SUB0"),!
.S BAR("SUB1")=""
.F S BAR("SUB1")=$O(^TMP($J,"BAR-ASMT",BAR("SUB0"),BAR("SUB1"))) Q:BAR("SUB1")="" D Q:$G(BAR("F1"))
..S BARTMP=$G(^TMP($J,"BAR-ASMT",BAR("SUB0"),BAR("SUB1")))
..W $$EN^BARVDF("HIN")
..W !!,$$CJ^XLFSTR(BAR("SUB1"),IOM),! ; Billing Entity/Allowance Category
..W $$EN^BARVDF("HIF")
..S BAR("SUB2")=""
..F S BAR("SUB2")=$O(^TMP($J,"BAR-ASMT",BAR("SUB0"),BAR("SUB1"),BAR("SUB2"))) Q:BAR("SUB2")="" D Q:$G(BAR("F1"))
...S BARTMPS=$G(^TMP($J,"BAR-ASMT",BAR("SUB0"),BAR("SUB1"),BAR("SUB2")))
...W !?1,BAR("SUB2") ; A/R Account
...S BAR("SUB3")=""
...F S BAR("SUB3")=$O(^TMP($J,"BAR-ASMT",BAR("SUB0"),BAR("SUB1"),BAR("SUB2"),BAR("SUB3"))) Q:BAR("SUB3")="" D Q:$G(BAR("F1"))
....I $Y>(IOSL-5) D HD Q:$G(BAR("F1"))
....S BARTMPS2=$G(^TMP($J,"BAR-ASMT",BAR("SUB0"),BAR("SUB1"),BAR("SUB2"),BAR("SUB3")))
....W !?2,$E(BAR("SUB3"),1,17)
....W ?20,$J($P(BARTMPS2,U),9,2) ; CURRENT
....W ?30,$J($P(BARTMPS2,U,2),9,2) ; 31-60
....W ?40,$J($P(BARTMPS2,U,3),9,2) ; 61-90
....W ?50,$J($P(BARTMPS2,U,4),9,2) ; 90-120
....W ?60,$J($P(BARTMPS2,U,5),9,2) ; 120+
....W ?70,$J($P(BARTMPS2,U,6),10,2) ; BALANCE
...Q:$G(BAR("F1"))
...W !,BARDASH,!
...W "A/R ACCOUNT TOTAL"
...D ACCOUNT
...W !
..Q:$G(BAR("F1"))
..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 SUM2 ; Subtotals by Billing Entity/Allowance Category
.Q:$G(BAR("F1"))
.S BARTMP=$G(^TMP($J,"BAR-ASMT",BAR("SUB0")))
.W !,BARDASH,!,"*** VISIT Loc Total"
.D SUM2
Q:$G(BAR("F1"))
W !
D TOTAL ; Report Totals
I '$D(BARA),(XQY0'["UFMS") D EOP^BARUTL(0) ;If not USM Pause IHS/DIT/CPC - 20180502 BAR*1.8*28 CR8350
Q
; ********************************************************************
;
ACCOUNT ;
; Account line on Summary reports
W ?20,$J($P(BARTMPS,U),9,2) ; CURRENT
W ?30,$J($P(BARTMPS,U,2),9,2) ; 31-60
W ?40,$J($P(BARTMPS,U,3),9,2) ; 61-90
W ?50,$J($P(BARTMPS,U,4),9,2) ; 90-120
W ?60,$J($P(BARTMPS,U,5),9,2) ; 120+
W ?70,$J($P(BARTMPS,U,6),10,2) ; BALANCE
Q
; ********************************************************************
;
SUM2 ;
; Billing Entity/Allowance Category Summary line
W ?20,$J($P(BARTMP,U),9,2) ; CURRENT
W ?30,$J($P(BARTMP,U,2),9,2) ; 31-60
W ?40,$J($P(BARTMP,U,3),9,2) ; 61-90
W ?50,$J($P(BARTMP,U,4),9,2) ; 90-120
W ?60,$J($P(BARTMP,U,5),9,2) ; 120+
W ?70,$J($P(BARTMP,U,6),10,2) ; BALANCE
Q
; ********************************************************************
;
TOTAL ;
; Report totals for Billing Entity/Allowance Category Reports
W BAREQUAL
S BARTMP=$G(^TMP($J,"BAR-ASMT"))
W !?20,$J($P(BARTMP,U),9,2) ; CURRENT
W ?30,$J($P(BARTMP,U,2),9,2) ; 31-60
W ?40,$J($P(BARTMP,U,3),9,2) ; 61-90
W ?50,$J($P(BARTMP,U,4),9,2) ; 90-120
W ?60,$J($P(BARTMP,U,5),9,2) ; 120+
W ?70,$J($P(BARTMP,U,6),10,2) ; BALANCE
Q
; ********************************************************************
;
HD ; EP
;D PAZ^BARRUTL ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594 IHS/DIT/CPC CR8350 BAR*1.8*28 20180502 Now they want the pause.
I XQY0'["UFMS" D PAZ^BARRUTL ;only do pause for ASM, not USM ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
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(132)):132,1:80))=""
W !,BAR("DASH"),!
Q
BARRASMB ; IHS/SD/LSL - Age Summary Report Print Logic ;08/20/2008
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**7,28**;OCT 26, 2005;Build 92
+2 ; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892
+3 ;IHS/ASDS/LSL - 11/24/03 - Routine created
+4 ; Called from BARRASM
+5 ; PRINT^BARRASMA - Print report
+6 ; Split from BARRASMA in V1.7 Patch 4 as BARRASMA became too large
+7 ;
+8 ;IHS/SD/LSL - 02/20/03 - V1.7 Patch 1 - Added DISCHARGE SERVICE sort and report. Add time run to report
+9 ; headers. (While still BARRASMA)
+10 ;IHS/SD/LSL - 08/01/03 - V1.7 Patch 2 - Add call to ASM^BAREISS to print of summary data (While still BARRASMA)
+11 ;IHS/SD/LSL - 11/24/03 - V1.7 Patch 4 - Add Visit Location Sort level to accomodate EISS
+12 ;
+13 ;IHS/SD/SDR 1.8*28 CR8350 HEAT295594 - Made call for EISS report conditional on BARA. BARA is set when running the USM report.
+14 ; we don't want the EISS run if running the USM report.
+15 QUIT
+16 ; *********************************************************************
PRINT ; EP
+1 ; Print reports
+2 FOR I=1:1:6
KILL BAR(I)
+3 KILL BAR("SUB0")
+4 KILL BAR("SUB1"),BAR("SUB2"),BAR("SUB3"),BARTMP,BARTMPS,BARTMPS2,BARNAME
+5 SET BAR("PG")=0
+6 SET BARDASH=" --------- --------- --------- --------- --------- ----------"
+7 SET BAREQUAL=" ========= ========= ========= ========= ========= =========="
+8 SET BAR("COL")="W !,BARY(""STCR"",""NM""),?22,""CURRENT"",?34,""31-60"",?44,""61-90"",?53,""91-120"",?65,""120+"",?73,""BALANCE"""
+9 IF ",1,2,3,4,"[(","_BARY("STCR")_",")
DO STANDARD
+10 IF $GET(BAR("F1"))
QUIT
+11 IF $GET(BARY("RTYP"))=1
DO SUMMARY
+12 IF $GET(BAR("F1"))
QUIT
+13 IF $GET(BARY("RTYP"))=2
DO DETAIL
+14 IF $GET(BAR("F1"))
QUIT
+15 IF $GET(BARY("RTYP"))=3
DO BILL
+16 IF $GET(BAR("F1"))
QUIT
+17 QUIT
+18 ; *********************************************************************
+19 ;
STANDARD ;
+1 ; Print report if user selected SORT CRITERIA a/r account, visit, or
+2 ; clinic
+3 ;
+4 ; Page and column header
DO HDB
+5 ; No data - quit
IF '$DATA(^TMP($JOB,"BAR-ASM"))
Begin DoDot:1
+6 WRITE !!!!!?25,"*** NO DATA TO PRINT ***"
+7 ;D EOP^BARUTL(0) ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594 -NOW WANT PAUSE IHS/DIT/CPC - 20180502 CR8350
+8 ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594 -NOW WANT PAUSE IHS/DIT/CPC - 20180502 CR8350
IF '$DATA(BARA)
IF (XQY0'["UFMS")
DO EOP^BARUTL(0)
End DoDot:1
QUIT
+9 SET BARHOLD("SUB0")=$ORDER(^TMP($JOB,"BAR-ASM",""))
+10 SET BAR("SUB0")=""
+11 FOR
SET BAR("SUB0")=$ORDER(^TMP($JOB,"BAR-ASM",BAR("SUB0")))
IF BAR("SUB0")=""
QUIT
Begin DoDot:1
+12 IF BARHOLD("SUB0")'=BAR("SUB0")
DO HD
+13 IF $GET(BAR("F1"))
QUIT
+14 SET BARHOLD("SUB0")=BAR("SUB0")
+15 IF '$DATA(BARY("LOC"))
WRITE !,"*** VISIT Location: ",BAR("SUB0"),!
+16 SET BAR("SUB1")=""
+17 FOR
SET BAR("SUB1")=$ORDER(^TMP($JOB,"BAR-ASM",BAR("SUB0"),BAR("SUB1")))
IF BAR("SUB1")=""
QUIT
Begin DoDot:2
+18 ;-NO PAUSE IHS/DIT/CPC - 20180502 CR8350
IF $Y>(IOSL-5)
IF '$DATA(BARA)
IF (XQY0'["UFMS")
DO EOP^BARUTL(0)
DO HD
IF $GET(BAR("F1"))
QUIT
+19 SET BARTMP=$GET(^TMP($JOB,"BAR-ASM",BAR("SUB0"),BAR("SUB1")))
+20 SET BARNAME=BAR("SUB1")
+21 ; clinic/vis typ/A/R acct/discharge svc
WRITE !,$EXTRACT(BARNAME,1,19)
+22 ; CURRENT
WRITE ?20,$JUSTIFY($PIECE(BARTMP,U),9,2)
+23 ; 31-60
WRITE ?30,$JUSTIFY($PIECE(BARTMP,U,2),9,2)
+24 ; 61-90
WRITE ?40,$JUSTIFY($PIECE(BARTMP,U,3),9,2)
+25 ; 90-120
WRITE ?50,$JUSTIFY($PIECE(BARTMP,U,4),9,2)
+26 ; 120+
WRITE ?60,$JUSTIFY($PIECE(BARTMP,U,5),9,2)
+27 ; BALANCE
WRITE ?70,$JUSTIFY($PIECE(BARTMP,U,6),10,2)
End DoDot:2
IF $GET(BAR("F1"))
QUIT
+28 ;
+29 ; Visit Location Totals
+30 IF $GET(BAR("F1"))
QUIT
+31 WRITE !,BARDASH
+32 SET BARTMP=$GET(^TMP($JOB,"BAR-ASM",BAR("SUB0")))
+33 WRITE !,"*** VISIT loc Total"
+34 ; CURRENT
WRITE ?20,$JUSTIFY($PIECE(BARTMP,U),9,2)
+35 ; 31-60
WRITE ?30,$JUSTIFY($PIECE(BARTMP,U,2),9,2)
+36 ; 61-90
WRITE ?40,$JUSTIFY($PIECE(BARTMP,U,3),9,2)
+37 ; 90-120
WRITE ?50,$JUSTIFY($PIECE(BARTMP,U,4),9,2)
+38 ; 120+
WRITE ?60,$JUSTIFY($PIECE(BARTMP,U,5),9,2)
+39 ; BALANCE
WRITE ?70,$JUSTIFY($PIECE(BARTMP,U,6),10,2)
End DoDot:1
IF $GET(BAR("F1"))
QUIT
+40 IF $GET(BAR("F1"))
QUIT
+41 ;
+42 ; Report Totals
+43 WRITE !,BAREQUAL
+44 SET BARTMP=$GET(^TMP($JOB,"BAR-ASM"))
+45 ; CURRENT
WRITE !?20,$JUSTIFY($PIECE(BARTMP,U),9,2)
+46 ; 31-60
WRITE ?30,$JUSTIFY($PIECE(BARTMP,U,2),9,2)
+47 ; 61-90
WRITE ?40,$JUSTIFY($PIECE(BARTMP,U,3),9,2)
+48 ; 90-120
WRITE ?50,$JUSTIFY($PIECE(BARTMP,U,4),9,2)
+49 ; 120+
WRITE ?60,$JUSTIFY($PIECE(BARTMP,U,5),9,2)
+50 ; BALANCE
WRITE ?70,$JUSTIFY($PIECE(BARTMP,U,6),10,2)
+51 ;D EOP^BARUTL(0) ;-NOW WANT PAUSE IHS/DIT/CPC - 20180502 CR8350
+52 ;If not USM Pause IHS/DIT/CPC - 20180502 BAR*1.8*28 CR8350
IF '$DATA(BARA)
IF (XQY0'["UFMS")
DO EOP^BARUTL(0)
+53 QUIT
+54 ; *********************************************************************
+55 ;
SUMMARY ;
+1 ; Print report if user selected SORT CRITERIA Billing Entity or
+2 ; Allowance Category and Report Type w/o payers
+3 ;
+4 ; Page and column header
DO HDB
+5 ; No data - quit
IF '$DATA(^TMP($JOB,"BAR-ASMT"))
Begin DoDot:1
+6 WRITE !!!!!?25,"*** NO DATA TO PRINT ***"
+7 ;D EOP^BARUTL(0) ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594 -NOW WANT PAUSE IHS/DIT/CPC - 20180502 CR8350
+8 ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594 -NOW WANT PAUSE IHS/DIT/CPC - 20180502 CR8350
IF '$DATA(BARA)
IF (XQY0'["UFMS")
DO EOP^BARUTL(0)
End DoDot:1
QUIT
+9 SET BARHOLD("SUB0")=$ORDER(^TMP($JOB,"BAR-ASMT",""))
+10 SET BAR("SUB0")=""
+11 FOR
SET BAR("SUB0")=$ORDER(^TMP($JOB,"BAR-ASMT",BAR("SUB0")))
IF BAR("SUB0")=""
QUIT
Begin DoDot:1
+12 IF BAR("SUB0")'=BARHOLD("SUB0")
DO HD
+13 IF $GET(BAR("F1"))
QUIT
+14 SET BARHOLD("SUB0")=BAR("SUB0")
+15 IF '$DATA(BARY("LOC"))
WRITE !,"*** VISIT Location: ",BAR("SUB0"),!
+16 SET BAR("SUB1")=""
+17 FOR
SET BAR("SUB1")=$ORDER(^TMP($JOB,"BAR-ASMT",BAR("SUB0"),BAR("SUB1")))
IF BAR("SUB1")=""
QUIT
Begin DoDot:2
+18 IF $Y>(IOSL-5)
DO HD
IF $GET(BAR("F1"))
QUIT
+19 SET BARTMP=$GET(^TMP($JOB,"BAR-ASMT",BAR("SUB0"),BAR("SUB1")))
+20 ; Billing Entity/Allowance Category/Insurer Type
WRITE !,$EXTRACT(BAR("SUB1"),1,19)
+21 DO SUM2
End DoDot:2
IF $GET(BAR("F1"))
QUIT
+22 IF $GET(BAR("F1"))
QUIT
+23 SET BARTMP=$GET(^TMP($JOB,"BAR-ASMT",BAR("SUB0")))
+24 WRITE !,BARDASH,!,"*** VISIT Loc Total"
+25 DO SUM2
End DoDot:1
IF $GET(BAR("F1"))
QUIT
+26 IF $GET(BAR("F1"))
QUIT
+27 WRITE !
+28 ; Report Totals
DO TOTAL
+29 ;I BARY("STCR")=5,'$D(BARY("ALL")) D ASM^BAREISS ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
+30 ;BARA is defined in the USM report; if started there, it shouldn't run the EISS report ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
IF BARY("STCR")=5
IF '$DATA(BARY("ALL"))
IF '$DATA(BARA)
DO ASM^BAREISS
+31 ;D EOP^BARUTL(0) ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594 -NOW WANT PAUSE IHS/DIT/CPC - 20180502 CR8350
+32 ;If not USM Pause IHS/DIT/CPC - 20180502 BAR*1.8*28 CR8350
IF '$DATA(BARA)
IF (XQY0'["UFMS")
DO EOP^BARUTL(0)
+33 QUIT
+34 ; *********************************************************************
+35 ;
DETAIL ;
+1 ; Print report if user selected SORT CRITERIA Billing Entity or
+2 ; Allowance Category and Report Type with payers
+3 ;
+4 ; Page and column header
DO HDB
+5 ; No data - quit
IF '$DATA(^TMP($JOB,"BAR-ASMT"))
Begin DoDot:1
+6 WRITE !!!!!?25,"*** NO DATA TO PRINT ***"
+7 ;D EOP^BARUTL(0) ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594 -NOW WANT PAUSE IHS/DIT/CPC - 20180502 CR8350
+8 ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594 -NOW WANT PAUSE IHS/DIT/CPC - 20180502 CR8350
IF '$DATA(BARA)
IF (XQY0'["UFMS")
DO EOP^BARUTL(0)
DO EOP^BARUTL(0)
End DoDot:1
QUIT
+9 ;
+10 SET BARHOLD("SUB0")=$ORDER(^TMP($JOB,"BAR-ASMT",""))
+11 SET BAR("SUB0")=""
+12 FOR
SET BAR("SUB0")=$ORDER(^TMP($JOB,"BAR-ASMT",BAR("SUB0")))
IF BAR("SUB0")=""
QUIT
Begin DoDot:1
+13 IF BAR("SUB0")'=BARHOLD("SUB0")
DO HD
+14 IF $GET(BAR("F1"))
QUIT
+15 SET BARHOLD("SUB0")=BAR("SUB0")
+16 IF '$DATA(BARY("LOC"))
WRITE !,"*** VISIT Location: ",BAR("SUB0"),!
+17 SET BAR("SUB1")=""
+18 FOR
SET BAR("SUB1")=$ORDER(^TMP($JOB,"BAR-ASMT",BAR("SUB0"),BAR("SUB1")))
IF BAR("SUB1")=""
QUIT
Begin DoDot:2
+19 SET BARTMP=$GET(^TMP($JOB,"BAR-ASMT",BAR("SUB0"),BAR("SUB1")))
+20 ; Billing Entity/Allowance Category
WRITE !,$EXTRACT(BAR("SUB1"),1,19)
+21 SET BAR("SUB2")=""
+22 FOR
SET BAR("SUB2")=$ORDER(^TMP($JOB,"BAR-ASMT",BAR("SUB0"),BAR("SUB1"),BAR("SUB2")))
IF BAR("SUB2")=""
QUIT
Begin DoDot:3
+23 IF $Y>(IOSL-5)
DO HD
IF $GET(BAR("F1"))
QUIT
+24 SET BARTMPS=$GET(^TMP($JOB,"BAR-ASMT",BAR("SUB0"),BAR("SUB1"),BAR("SUB2")))
+25 ; A/R Account
WRITE !?1,$EXTRACT(BAR("SUB2"),1,18)
+26 DO ACCOUNT
+27 IF $GET(BAR("F1"))
QUIT
End DoDot:3
IF $GET(BAR("F1"))
QUIT
+28 IF $GET(BAR("F1"))
QUIT
+29 WRITE !,BARDASH,!
+30 IF BARY("STCR")=5
WRITE "ALLOW CAT TOTAL"
+31 IF BARY("STCR")=6
WRITE "BILL ENTITY TOTAL"
+32 IF BARY("STCR")=7
WRITE "INS TYPE TOTAL"
+33 ; Subtotals by Billing Entity/Allowance Category
DO SUM2
End DoDot:2
IF $GET(BAR("F1"))
QUIT
+34 IF $GET(BAR("F1"))
QUIT
+35 SET BARTMP=$GET(^TMP($JOB,"BAR-ASMT",BAR("SUB0")))
+36 WRITE !,BARDASH,!,"*** VISIT Loc Total"
+37 DO SUM2
End DoDot:1
IF $GET(BAR("F1"))
QUIT
+38 IF $GET(BAR("F1"))
QUIT
+39 WRITE !
+40 ; Report Totals
DO TOTAL
+41 ;D EOP^BARUTL(0) ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594 -NOW WANT PAUSE IHS/DIT/CPC - 20180502 CR8350
+42 ;If not USM Pause IHS/DIT/CPC - 20180502 BAR*1.8*28 CR8350
IF '$DATA(BARA)
IF (XQY0'["UFMS")
DO EOP^BARUTL(0)
+43 QUIT
+44 ; ********************************************************************
+45 ;
BILL ;
+1 ; Print report if user selected SORT CRITERIA Billing Entity or
+2 ; Allowance Category and Report Type with payers AND bills
+3 ;
+4 ; Page and column header
DO HDB
+5 ; No data - quit
IF '$DATA(^TMP($JOB,"BAR-ASMT"))
Begin DoDot:1
+6 WRITE !!!!!?25,"*** NO DATA TO PRINT ***"
+7 ;D EOP^BARUTL(0) ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
+8 ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594 - NO USM PAGE BREAKS IHS/DIT/CPC - 20180502
IF '$DATA(BARA)
IF (XQY0'["UFMS")
DO EOP^BARUTL(0)
End DoDot:1
QUIT
+9 ;
+10 SET BARHOLD("SUB0")=$ORDER(^TMP($JOB,"BAR-ASMT",""))
+11 SET BAR("SUB0")=""
+12 FOR
SET BAR("SUB0")=$ORDER(^TMP($JOB,"BAR-ASMT",BAR("SUB0")))
IF BAR("SUB0")=""
QUIT
Begin DoDot:1
+13 IF BAR("SUB0")'=BARHOLD("SUB0")
DO HD
+14 IF $GET(BAR("F1"))
QUIT
+15 SET BARHOLD("SUB0")=BAR("SUB0")
+16 IF '$DATA(BARY("LOC"))
WRITE !,"*** VISIT Location: ",BAR("SUB0"),!
+17 SET BAR("SUB1")=""
+18 FOR
SET BAR("SUB1")=$ORDER(^TMP($JOB,"BAR-ASMT",BAR("SUB0"),BAR("SUB1")))
IF BAR("SUB1")=""
QUIT
Begin DoDot:2
+19 SET BARTMP=$GET(^TMP($JOB,"BAR-ASMT",BAR("SUB0"),BAR("SUB1")))
+20 WRITE $$EN^BARVDF("HIN")
+21 ; Billing Entity/Allowance Category
WRITE !!,$$CJ^XLFSTR(BAR("SUB1"),IOM),!
+22 WRITE $$EN^BARVDF("HIF")
+23 SET BAR("SUB2")=""
+24 FOR
SET BAR("SUB2")=$ORDER(^TMP($JOB,"BAR-ASMT",BAR("SUB0"),BAR("SUB1"),BAR("SUB2")))
IF BAR("SUB2")=""
QUIT
Begin DoDot:3
+25 SET BARTMPS=$GET(^TMP($JOB,"BAR-ASMT",BAR("SUB0"),BAR("SUB1"),BAR("SUB2")))
+26 ; A/R Account
WRITE !?1,BAR("SUB2")
+27 SET BAR("SUB3")=""
+28 FOR
SET BAR("SUB3")=$ORDER(^TMP($JOB,"BAR-ASMT",BAR("SUB0"),BAR("SUB1"),BAR("SUB2"),BAR("SUB3")))
IF BAR("SUB3")=""
QUIT
Begin DoDot:4
+29 IF $Y>(IOSL-5)
DO HD
IF $GET(BAR("F1"))
QUIT
+30 SET BARTMPS2=$GET(^TMP($JOB,"BAR-ASMT",BAR("SUB0"),BAR("SUB1"),BAR("SUB2"),BAR("SUB3")))
+31 WRITE !?2,$EXTRACT(BAR("SUB3"),1,17)
+32 ; CURRENT
WRITE ?20,$JUSTIFY($PIECE(BARTMPS2,U),9,2)
+33 ; 31-60
WRITE ?30,$JUSTIFY($PIECE(BARTMPS2,U,2),9,2)
+34 ; 61-90
WRITE ?40,$JUSTIFY($PIECE(BARTMPS2,U,3),9,2)
+35 ; 90-120
WRITE ?50,$JUSTIFY($PIECE(BARTMPS2,U,4),9,2)
+36 ; 120+
WRITE ?60,$JUSTIFY($PIECE(BARTMPS2,U,5),9,2)
+37 ; BALANCE
WRITE ?70,$JUSTIFY($PIECE(BARTMPS2,U,6),10,2)
End DoDot:4
IF $GET(BAR("F1"))
QUIT
+38 IF $GET(BAR("F1"))
QUIT
+39 WRITE !,BARDASH,!
+40 WRITE "A/R ACCOUNT TOTAL"
+41 DO ACCOUNT
+42 WRITE !
End DoDot:3
IF $GET(BAR("F1"))
QUIT
+43 IF $GET(BAR("F1"))
QUIT
+44 WRITE BARDASH,!
+45 IF BARY("STCR")=5
WRITE "ALLOW CAT TOTAL"
+46 IF BARY("STCR")=6
WRITE "BILL ENTITY TOTAL"
+47 IF BARY("STCR")=7
WRITE "INS TYPE TOTAL"
+48 ; Subtotals by Billing Entity/Allowance Category
DO SUM2
End DoDot:2
IF $GET(BAR("F1"))
QUIT
+49 IF $GET(BAR("F1"))
QUIT
+50 SET BARTMP=$GET(^TMP($JOB,"BAR-ASMT",BAR("SUB0")))
+51 WRITE !,BARDASH,!,"*** VISIT Loc Total"
+52 DO SUM2
End DoDot:1
IF $GET(BAR("F1"))
QUIT
+53 IF $GET(BAR("F1"))
QUIT
+54 WRITE !
+55 ; Report Totals
DO TOTAL
+56 ;If not USM Pause IHS/DIT/CPC - 20180502 BAR*1.8*28 CR8350
IF '$DATA(BARA)
IF (XQY0'["UFMS")
DO EOP^BARUTL(0)
+57 QUIT
+58 ; ********************************************************************
+59 ;
ACCOUNT ;
+1 ; Account line on Summary reports
+2 ; CURRENT
WRITE ?20,$JUSTIFY($PIECE(BARTMPS,U),9,2)
+3 ; 31-60
WRITE ?30,$JUSTIFY($PIECE(BARTMPS,U,2),9,2)
+4 ; 61-90
WRITE ?40,$JUSTIFY($PIECE(BARTMPS,U,3),9,2)
+5 ; 90-120
WRITE ?50,$JUSTIFY($PIECE(BARTMPS,U,4),9,2)
+6 ; 120+
WRITE ?60,$JUSTIFY($PIECE(BARTMPS,U,5),9,2)
+7 ; BALANCE
WRITE ?70,$JUSTIFY($PIECE(BARTMPS,U,6),10,2)
+8 QUIT
+9 ; ********************************************************************
+10 ;
SUM2 ;
+1 ; Billing Entity/Allowance Category Summary line
+2 ; CURRENT
WRITE ?20,$JUSTIFY($PIECE(BARTMP,U),9,2)
+3 ; 31-60
WRITE ?30,$JUSTIFY($PIECE(BARTMP,U,2),9,2)
+4 ; 61-90
WRITE ?40,$JUSTIFY($PIECE(BARTMP,U,3),9,2)
+5 ; 90-120
WRITE ?50,$JUSTIFY($PIECE(BARTMP,U,4),9,2)
+6 ; 120+
WRITE ?60,$JUSTIFY($PIECE(BARTMP,U,5),9,2)
+7 ; BALANCE
WRITE ?70,$JUSTIFY($PIECE(BARTMP,U,6),10,2)
+8 QUIT
+9 ; ********************************************************************
+10 ;
TOTAL ;
+1 ; Report totals for Billing Entity/Allowance Category Reports
+2 WRITE BAREQUAL
+3 SET BARTMP=$GET(^TMP($JOB,"BAR-ASMT"))
+4 ; CURRENT
WRITE !?20,$JUSTIFY($PIECE(BARTMP,U),9,2)
+5 ; 31-60
WRITE ?30,$JUSTIFY($PIECE(BARTMP,U,2),9,2)
+6 ; 61-90
WRITE ?40,$JUSTIFY($PIECE(BARTMP,U,3),9,2)
+7 ; 90-120
WRITE ?50,$JUSTIFY($PIECE(BARTMP,U,4),9,2)
+8 ; 120+
WRITE ?60,$JUSTIFY($PIECE(BARTMP,U,5),9,2)
+9 ; BALANCE
WRITE ?70,$JUSTIFY($PIECE(BARTMP,U,6),10,2)
+10 QUIT
+11 ; ********************************************************************
+12 ;
HD ; EP
+1 ;D PAZ^BARRUTL ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594 IHS/DIT/CPC CR8350 BAR*1.8*28 20180502 Now they want the pause.
+2 ;only do pause for ASM, not USM ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
IF XQY0'["UFMS"
DO PAZ^BARRUTL
+3 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
SET BAR("F1")=1
QUIT
+4 ; -------------------------------
+5 ;
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(132)):132,1:80))=""
+7 WRITE !,BAR("DASH"),!
+8 QUIT
