BARRNBRB ; IHS/SD/POT - Non Ben Payment Report PART 2
;;1.8;IHS ACCOUNTS RECEIVABLE;**24**;OCT 26, 2005;Build 69
; IHS/SD/POT 07/15/13 HEAT114352 NEW REPORT BAR*1.8*24
; IHS/SD/POT 01/14/14 FIXED: IDENTIFY PAYMENTS TO OTHER PAT
; IHS/SD/POT 03/21/14 ADJUSTED TOTAL BILL LINE
Q
; *********************************************************************
;
PRINT ; EP
S BARMODE="S"
I $G(BARY("RTYP"))=1 S BARMODE="D"
; 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=" =============== ============== ============== ============="
;
D BILL
;;;D STANDARD 1/13/2014
D XIT
Q
; *********************************************************************
;
STANDARD ;
; Print report if user selected SORT CRITERIA a/r account, visit, or
; clinic
;
D HDB
I '$D(^TMP($J,"BAR-NBR")) D Q ; No data - quit
. W !!!!!?25,"*** NO DATA TO PRINT ***"
. D EOP^BARUTL(0)
;
S BARHOLD("SUB1")=$O(^TMP($J,"BAR-NBR",""))
S BAR("SUB1")=""
F S BAR("SUB1")=$O(^TMP($J,"BAR-NBR",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-NBR",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-NBR",BAR("SUB1"),BAR("SUB2")))
S BARNAME=BAR("SUB2")
W !,$E(BARNAME,1,19) ; clinic/vis typ
D STNDLINE
Q
; ********************************************************************
;
STNDLTOT ;
; Visit Location Totals (Standard format)
Q:$G(BAR("F1"))
W !,BARDASH,!
S BARTMP=$G(^TMP($J,"BAR-NBR",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-NBR"))
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-NBRT")) D Q ; No data - quit
. W !!!!!?25,"*** NO DATA TO PRINT ***"
. D EOP^BARUTL(0)
;
S BARHOLD("SUB1")=$O(^TMP($J,"BAR-NBRT",""))
S BAR("SUB1")=""
F S BAR("SUB1")=$O(^TMP($J,"BAR-NBRT",BAR("SUB1"))) Q:BAR("SUB1")="" D SUMLOC Q:$G(BAR("F1"))
W !
D SUMTOT
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-NBRT",BAR("SUB1"),BAR("SUB3"))) Q:BAR("SUB3")="" D SUMDET Q:$G(BAR("F1"))
W !
D SUMLTOT
Q
; ********************************************************************
;
SUMDET ;
QUIT
; ********************************************************************
;
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-NBRT")) D Q ; No data - quit
. W !!!!!?25,"*** NO DATA TO PRINT ***"
. D EOP^BARUTL(0)
;
S BARHOLD("SUB1")=$O(^TMP($J,"BAR-NBRT",""))
S BAR("SUB1")=""
F S BAR("SUB1")=$O(^TMP($J,"BAR-NBRT",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-NBRT",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-NBRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"))) Q:BAR("SUB4")="" D DETDET Q:$G(BAR("F1"))
W !
D BEALTOT
Q
; ********************************************************************
;
DETDET ;
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-NBRT")) D Q ; No data - quit
. W !!!!!?25,"*** NO DATA TO PRINT ***"
. D EOP^BARUTL(0)
;
S BARHOLD("SUB1")=$O(^TMP($J,"BAR-NBRT",""))
S BAR("SUB1")="" F S BAR("SUB1")=$O(^TMP($J,"BAR-NBRT",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-NBRT",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),! ;P.OTT
W $$EN^BARVDF("HIF")
S BAR("SUB4")=""
F S BAR("SUB4")=$O(^TMP($J,"BAR-NBRT",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 ...
S BAR("SUB5")=""
F S BAR("SUB5")=$O(^TMP($J,"BAR-NBRT",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-NBRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"),BAR("SUB5")))
;
I BARMODE="D" D Q ;DETAILED
. D BILLLOOP
. D BILLLINE
. ;D STNDLINE
. W !
. Q
S BARTMP=$G(^TMP($J,"BAR-NBRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"),BAR("SUB5")))
W !,$P(BAR("SUB5"),"-") ;SUMMARY FOR BILL
D STNDLINE
Q
; ********************************************************************
;
BILLLOOP ;^TMP(4212,"BAR-NBR9",29055,5496)="3060413.141933^29055A-IH-12770^101^101^0^12770"
;FROM BILL_NUMBER-FULL^BILLED^BALANCE^INS^PAT^PATIENT_IEN
;TO: ^BILLED^BALANCE^INS^PAT^
N BARBILL,BARBL,BARTMP1,BARTMP2,BARD1,BARD2,BARD3,BARD4,BARCNT
S BARBILL=$P(BAR("SUB5"),"-") ; p.ott BILL # PART1
S BARBL="0" F S BARBL=$O(^TMP($J,"BAR-NBR9",BARBILL,BARBL)) Q:+BARBL=0 D Q:$G(BAR("F1"))
. S BARTMP1=$G(^TMP($J,"BAR-NBR9",BARBILL,BARBL))
. S BARFULL=$P(BARTMP1,"^",1)
. S BARD1=$P(BARTMP1,"^",2) ;AMT BILLED
. S BARD4=$P(BARTMP1,"^",3) ;BALANCE
. W !,BARFULL
. S BARCNT=0
. S BARTR="0" F S BARTR=$O(^TMP($J,"BAR-NBR9",BARBILL,BARBL,BARTR)) Q:+BARTR=0 D Q:$G(BAR("F1"))
. . S BARTMP2=$G(^TMP($J,"BAR-NBR9",BARBILL,BARBL,BARTR))
. . ;S BARTRT=$P(BARTMP2,"^",3) I BARTRT'=40 Q ;W !,BARTR," NO PAYMENT" QUIT
. . S BARFLG=$P(BARTMP2,"^",8),BARAMT=$P(BARTMP2,"^",7)
. . S BARD2=0,BARD3=0
. . S BARD2=BARAMT I BARFLG S BARD3=BARAMT,BARD2=0 ;PAT OR INS?
. . S BARCNT=BARCNT+1 ;I BARCNT>1 W !
. . W ! ;,BARTR
. . I BARD3>0 W ?10,$$MDY(BARTR\1) ;DISPLAY DATE ONLY FOR PAT PAYMENTS (!)
. . D STNDLN2(BARBL)
. I BARCNT=0 D
. . W ?36,$J($FN(0,",",2),14) ; INS
. . W ?51,$J($FN(0,",",2),14) ; PAT
. Q
W !,BARDASH
;W !,"*** BILL ",BARBILL," Total"
W !,"*** ",BARBILL," Total"
Q
STNDLN2(BARBL) ;
I BARCNT=1 W ?20,$J($FN(BARD1,",",2),15) ; Amount billed
W ?36,$J($FN(BARD2,",",2),14) ; INS
W ?51,$J($FN(BARD3,",",2),14) ; PAT
I BARFLG<0 W "*" ;1/14/2014
I BARCNT=1 W ?66,$J($FN(BARD4,",",2),13) ;
Q
SUMTOT ;
; Report totals (summary, detail, bill)
Q:$G(BAR("F1"))
S BARTMP=$G(^TMP($J,"BAR-NBRT"))
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-NBRT",BAR("SUB1")))
W BARDASH,!
W "*** VISIT Loc Total"
D STNDLINE
Q
; ********************************************************************
;
BEALTOT ;
; Billing Entity / Allowance Category totals (detail, bill)
Q ;P.OTT
Q:$G(BAR("F1"))
S BARTMP=$G(^TMP($J,"BAR-NBRT",BAR("SUB1"),BAR("SUB3")))
W BARDASH,!
W " ** Total"
D STNDLINE
Q
; ********************************************************************
;
ACCTTOT ;
; A/R Account totals (bill)
Q ;P.OTT
Q:$G(BAR("F1"))
S BARTMP=$G(^TMP($J,"BAR-NBRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4")))
W !,BARDASH,!
W " * A/R Acct Total"
D STNDLINE
W !
Q
; ********************************************************************
;
BILLLINE ;SUM FOR BILL (XXXX (A,B,C)
N BARBILL,BARTMP
S BARBILL=$P(BAR("SUB5"),"-") ; p.ott BILL # PART1
S BARTMP=$G(^TMP($J,"BAR-NBR9",BARBILL))
W ?20,$J($FN($P(BARTMP,U),",",2),15) ; Amount billed
W ?36,$J($FN($P(BARTMP,U,2),",",2),14) ; Patient Payments
W ?51,$J($FN($P(BARTMP,U,3),",",2),14) ; insurance payments
W ?66,$J($FN($P(BARTMP,U,4),",",2),13) ; balance
Q
STNDLINE ;
W ?20,$J($FN($P(BARTMP,U),",",2),15) ; Amount billed
W ?36,$J($FN($P(BARTMP,U,2),",",2),14) ; Patient Payments
W ?51,$J($FN($P(BARTMP,U,3),",",2),14) ; insurance payments
W ?66,$J($FN($P(BARTMP,U,4),",",2),13) ; balance
Q
; ********************************************************************
;
B13(BARBL) ;
Q
B15(BARBL) ;
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
D HDRBAR(BARMODE) ;12/31/2013
S $P(BAR("DASH"),"=",$S($D(BAR(133)):132,1:81))=""
W !,BAR("DASH"),!
Q
; ********************************************************************
;
XIT ;
K ^TMP($J,"BAR-NBR")
K ^TMP($J,"BAR-NBRT")
Q
HDRBAR(BARMODE) ;
I BARMODE="D" D Q
. W !,"Bill",?10,"Pt Payment",?29,"Amount",?43,"Insurance",?58,"Patient"
. W !,"Number",?9,"Posted Date",?29,"Billed",?43,"Payment",?58,"Payment",?72,"Balance"
I BARMODE="S" D Q
. W !,"Bill",?29,"Amount",?43,"Insurance",?58,"Patient"
. W !,"Number",?29,"Billed",?43,"Payment",?58,"Payment",?72,"Balance"
Q
MDY(BARD) ; format Date from FM to MM/DD/YYYY
N BARFMMM,BARFMDD,BARFMYY
S BARFMMM=$E(BARD,4,5)
S BARFMDD=$E(BARD,6,7)
S BARFMYY=$E(BARD,1,3)+1700
Q BARFMMM_"/"_BARFMDD_"/"_BARFMYY
;----------EOR--------------
BARRNBRB ; IHS/SD/POT - Non Ben Payment Report PART 2
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**24**;OCT 26, 2005;Build 69
+2 ; IHS/SD/POT 07/15/13 HEAT114352 NEW REPORT BAR*1.8*24
+3 ; IHS/SD/POT 01/14/14 FIXED: IDENTIFY PAYMENTS TO OTHER PAT
+4 ; IHS/SD/POT 03/21/14 ADJUSTED TOTAL BILL LINE
+5 QUIT
+6 ; *********************************************************************
+7 ;
PRINT ; EP
+1 SET BARMODE="S"
+2 IF $GET(BARY("RTYP"))=1
SET BARMODE="D"
+3 ; Print reports
+4 FOR I=1:1:4
KILL BAR(I)
+5 FOR I=1:1:5
KILL BAR("SUB"_I)
+6 SET BAR("PG")=0
+7 SET BARDASH=" --------------- -------------- -------------- -------------"
+8 SET BAREQUAL=" =============== ============== ============== ============="
+9 ;
+10 DO BILL
+11 ;;;D STANDARD 1/13/2014
+12 DO XIT
+13 QUIT
+14 ; *********************************************************************
+15 ;
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-NBR"))
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-NBR",""))
+10 SET BAR("SUB1")=""
+11 FOR
SET BAR("SUB1")=$ORDER(^TMP($JOB,"BAR-NBR",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-NBR",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-NBR",BAR("SUB1"),BAR("SUB2")))
+4 SET BARNAME=BAR("SUB2")
+5 ; clinic/vis typ
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-NBR",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-NBR"))
+5 WRITE "***** REPORT TOTAL"
+6 DO STNDLINE
+7 QUIT
+8 ; *********************************************************************
+9 ;
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-NBRT"))
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-NBRT",""))
+10 SET BAR("SUB1")=""
+11 FOR
SET BAR("SUB1")=$ORDER(^TMP($JOB,"BAR-NBRT",BAR("SUB1")))
IF BAR("SUB1")=""
QUIT
DO SUMLOC
IF $GET(BAR("F1"))
QUIT
+12 WRITE !
+13 DO SUMTOT
+14 QUIT
+15 ; ********************************************************************
+16 ;
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-NBRT",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 QUIT
+2 ; ********************************************************************
+3 ;
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-NBRT"))
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-NBRT",""))
+9 SET BAR("SUB1")=""
+10 FOR
SET BAR("SUB1")=$ORDER(^TMP($JOB,"BAR-NBRT",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-NBRT",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-NBRT",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 ;
QUIT
+2 ; ********************************************************************
+3 ;
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-NBRT"))
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-NBRT",""))
+10 SET BAR("SUB1")=""
FOR
SET BAR("SUB1")=$ORDER(^TMP($JOB,"BAR-NBRT",BAR("SUB1")))
IF BAR("SUB1")=""
QUIT
DO BILLLOC
IF $GET(BAR("F1"))
QUIT
+11 WRITE !
+12 DO SUMTOT
+13 QUIT
+14 ; ********************************************************************
+15 ;
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-NBRT",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 ;;;W !,$$CJ^XLFSTR(BAR("SUB3"),IOM),! ;P.OTT
+4 WRITE $$EN^BARVDF("HIF")
+5 SET BAR("SUB4")=""
+6 FOR
SET BAR("SUB4")=$ORDER(^TMP($JOB,"BAR-NBRT",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 SET BAR("SUB5")=""
+3 FOR
SET BAR("SUB5")=$ORDER(^TMP($JOB,"BAR-NBRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"),BAR("SUB5")))
IF BAR("SUB5")=""
QUIT
DO BILLDET
IF $GET(BAR("F1"))
QUIT
+4 DO ACCTTOT
+5 QUIT
+6 ; ********************************************************************
+7 ;
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-NBRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"),BAR("SUB5")))
+4 ;
+5 ;DETAILED
IF BARMODE="D"
Begin DoDot:1
+6 DO BILLLOOP
+7 DO BILLLINE
+8 ;D STNDLINE
+9 WRITE !
+10 QUIT
End DoDot:1
QUIT
+11 SET BARTMP=$GET(^TMP($JOB,"BAR-NBRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"),BAR("SUB5")))
+12 ;SUMMARY FOR BILL
WRITE !,$PIECE(BAR("SUB5"),"-")
+13 DO STNDLINE
+14 QUIT
+15 ; ********************************************************************
+16 ;
BILLLOOP ;^TMP(4212,"BAR-NBR9",29055,5496)="3060413.141933^29055A-IH-12770^101^101^0^12770"
+1 ;FROM BILL_NUMBER-FULL^BILLED^BALANCE^INS^PAT^PATIENT_IEN
+2 ;TO: ^BILLED^BALANCE^INS^PAT^
+3 NEW BARBILL,BARBL,BARTMP1,BARTMP2,BARD1,BARD2,BARD3,BARD4,BARCNT
+4 ; p.ott BILL # PART1
SET BARBILL=$PIECE(BAR("SUB5"),"-")
+5 SET BARBL="0"
FOR
SET BARBL=$ORDER(^TMP($JOB,"BAR-NBR9",BARBILL,BARBL))
IF +BARBL=0
QUIT
Begin DoDot:1
+6 SET BARTMP1=$GET(^TMP($JOB,"BAR-NBR9",BARBILL,BARBL))
+7 SET BARFULL=$PIECE(BARTMP1,"^",1)
+8 ;AMT BILLED
SET BARD1=$PIECE(BARTMP1,"^",2)
+9 ;BALANCE
SET BARD4=$PIECE(BARTMP1,"^",3)
+10 WRITE !,BARFULL
+11 SET BARCNT=0
+12 SET BARTR="0"
FOR
SET BARTR=$ORDER(^TMP($JOB,"BAR-NBR9",BARBILL,BARBL,BARTR))
IF +BARTR=0
QUIT
Begin DoDot:2
+13 SET BARTMP2=$GET(^TMP($JOB,"BAR-NBR9",BARBILL,BARBL,BARTR))
+14 ;S BARTRT=$P(BARTMP2,"^",3) I BARTRT'=40 Q ;W !,BARTR," NO PAYMENT" QUIT
+15 SET BARFLG=$PIECE(BARTMP2,"^",8)
SET BARAMT=$PIECE(BARTMP2,"^",7)
+16 SET BARD2=0
SET BARD3=0
+17 ;PAT OR INS?
SET BARD2=BARAMT
IF BARFLG
SET BARD3=BARAMT
SET BARD2=0
+18 ;I BARCNT>1 W !
SET BARCNT=BARCNT+1
+19 ;,BARTR
WRITE !
+20 ;DISPLAY DATE ONLY FOR PAT PAYMENTS (!)
IF BARD3>0
WRITE ?10,$$MDY(BARTR\1)
+21 DO STNDLN2(BARBL)
End DoDot:2
IF $GET(BAR("F1"))
QUIT
+22 IF BARCNT=0
Begin DoDot:2
+23 ; INS
WRITE ?36,$JUSTIFY($FNUMBER(0,",",2),14)
+24 ; PAT
WRITE ?51,$JUSTIFY($FNUMBER(0,",",2),14)
End DoDot:2
+25 QUIT
End DoDot:1
IF $GET(BAR("F1"))
QUIT
+26 WRITE !,BARDASH
+27 ;W !,"*** BILL ",BARBILL," Total"
+28 WRITE !,"*** ",BARBILL," Total"
+29 QUIT
STNDLN2(BARBL) ;
+1 ; Amount billed
IF BARCNT=1
WRITE ?20,$JUSTIFY($FNUMBER(BARD1,",",2),15)
+2 ; INS
WRITE ?36,$JUSTIFY($FNUMBER(BARD2,",",2),14)
+3 ; PAT
WRITE ?51,$JUSTIFY($FNUMBER(BARD3,",",2),14)
+4 ;1/14/2014
IF BARFLG<0
WRITE "*"
+5 ;
IF BARCNT=1
WRITE ?66,$JUSTIFY($FNUMBER(BARD4,",",2),13)
+6 QUIT
SUMTOT ;
+1 ; Report totals (summary, detail, bill)
+2 IF $GET(BAR("F1"))
QUIT
+3 SET BARTMP=$GET(^TMP($JOB,"BAR-NBRT"))
+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-NBRT",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 ;P.OTT
QUIT
+3 IF $GET(BAR("F1"))
QUIT
+4 SET BARTMP=$GET(^TMP($JOB,"BAR-NBRT",BAR("SUB1"),BAR("SUB3")))
+5 WRITE BARDASH,!
+6 WRITE " ** Total"
+7 DO STNDLINE
+8 QUIT
+9 ; ********************************************************************
+10 ;
ACCTTOT ;
+1 ; A/R Account totals (bill)
+2 ;P.OTT
QUIT
+3 IF $GET(BAR("F1"))
QUIT
+4 SET BARTMP=$GET(^TMP($JOB,"BAR-NBRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4")))
+5 WRITE !,BARDASH,!
+6 WRITE " * A/R Acct Total"
+7 DO STNDLINE
+8 WRITE !
+9 QUIT
+10 ; ********************************************************************
+11 ;
BILLLINE ;SUM FOR BILL (XXXX (A,B,C)
+1 NEW BARBILL,BARTMP
+2 ; p.ott BILL # PART1
SET BARBILL=$PIECE(BAR("SUB5"),"-")
+3 SET BARTMP=$GET(^TMP($JOB,"BAR-NBR9",BARBILL))
+4 ; Amount billed
WRITE ?20,$JUSTIFY($FNUMBER($PIECE(BARTMP,U),",",2),15)
+5 ; Patient Payments
WRITE ?36,$JUSTIFY($FNUMBER($PIECE(BARTMP,U,2),",",2),14)
+6 ; insurance payments
WRITE ?51,$JUSTIFY($FNUMBER($PIECE(BARTMP,U,3),",",2),14)
+7 ; balance
WRITE ?66,$JUSTIFY($FNUMBER($PIECE(BARTMP,U,4),",",2),13)
+8 QUIT
STNDLINE ;
+1 ; Amount billed
WRITE ?20,$JUSTIFY($FNUMBER($PIECE(BARTMP,U),",",2),15)
+2 ; Patient Payments
WRITE ?36,$JUSTIFY($FNUMBER($PIECE(BARTMP,U,2),",",2),14)
+3 ; insurance payments
WRITE ?51,$JUSTIFY($FNUMBER($PIECE(BARTMP,U,3),",",2),14)
+4 ; balance
WRITE ?66,$JUSTIFY($FNUMBER($PIECE(BARTMP,U,4),",",2),13)
+5 QUIT
+6 ; ********************************************************************
+7 ;
B13(BARBL) ;
+1 QUIT
B15(BARBL) ;
+1 QUIT
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 ;12/31/2013
DO HDRBAR(BARMODE)
+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-NBR")
+2 KILL ^TMP($JOB,"BAR-NBRT")
+3 QUIT
HDRBAR(BARMODE) ;
+1 IF BARMODE="D"
Begin DoDot:1
+2 WRITE !,"Bill",?10,"Pt Payment",?29,"Amount",?43,"Insurance",?58,"Patient"
+3 WRITE !,"Number",?9,"Posted Date",?29,"Billed",?43,"Payment",?58,"Payment",?72,"Balance"
End DoDot:1
QUIT
+4 IF BARMODE="S"
Begin DoDot:1
+5 WRITE !,"Bill",?29,"Amount",?43,"Insurance",?58,"Patient"
+6 WRITE !,"Number",?29,"Billed",?43,"Payment",?58,"Payment",?72,"Balance"
End DoDot:1
QUIT
+7 QUIT
MDY(BARD) ; format Date from FM to MM/DD/YYYY
+1 NEW BARFMMM,BARFMDD,BARFMYY
+2 SET BARFMMM=$EXTRACT(BARD,4,5)
+3 SET BARFMDD=$EXTRACT(BARD,6,7)
+4 SET BARFMYY=$EXTRACT(BARD,1,3)+1700
+5 QUIT BARFMMM_"/"_BARFMDD_"/"_BARFMYY
+6 ;----------EOR--------------
