Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BARRNBRB

BARRNBRB.m

Go to the documentation of this file. 
  1. BARRNBRB ; IHS/SD/POT - Non Ben Payment Report PART 2
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**24**;OCT 26, 2005;Build 69
  1.  ; IHS/SD/POT 07/15/13 HEAT114352 NEW REPORT BAR*1.8*24
  1.  ; IHS/SD/POT 01/14/14 FIXED: IDENTIFY PAYMENTS TO OTHER PAT
  1.  ; IHS/SD/POT 03/21/14 ADJUSTED TOTAL BILL LINE
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. PRINT ; EP
  1.  S BARMODE="S"
  1.  I $G(BARY("RTYP"))=1 S BARMODE="D"
  1.  ; Print reports
  1.  F I=1:1:4 K BAR(I)
  1.  F I=1:1:5 K BAR("SUB"_I)
  1.  S BAR("PG")=0
  1.  S BARDASH="                     --------------- -------------- -------------- -------------"
  1.  S BAREQUAL="                    =============== ============== ============== ============="
  1.  ;
  1.  D BILL
  1.  ;;;D STANDARD 1/13/2014
  1.  D XIT
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. STANDARD ;
  1.  ; Print report if user selected SORT CRITERIA a/r account, visit, or
  1.  ; clinic
  1.  ;
  1.  D HDB
  1.  I '$D(^TMP($J,"BAR-NBR")) D  Q           ; No data - quit
  1.  . W !!!!!?25,"*** NO DATA TO PRINT ***"
  1.  . D EOP^BARUTL(0)
  1.  ;
  1.  S BARHOLD("SUB1")=$O(^TMP($J,"BAR-NBR",""))
  1.  S BAR("SUB1")=""
  1.  F  S BAR("SUB1")=$O(^TMP($J,"BAR-NBR",BAR("SUB1"))) Q:BAR("SUB1")=""  D STNDLOC Q:$G(BAR("F1"))
  1.  D STNDTOT
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. STNDLOC ;
  1.  ; For each Visit Location (Standard Format) Do...
  1.  I BAR("SUB1")'=BARHOLD("SUB1") D HD
  1.  Q:$G(BAR("F1"))
  1.  S BARHOLD("SUB1")=BAR("SUB1")
  1.  I '$D(BARY("LOC")) W !,"*** VISIT Location: ",BAR("SUB1"),!
  1.  S BAR("SUB2")=""
  1.  F  S BAR("SUB2")=$O(^TMP($J,"BAR-NBR",BAR("SUB1"),BAR("SUB2"))) Q:BAR("SUB2")=""  D STNDDET Q:$G(BAR("F1"))
  1.  D STNDLTOT
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. STNDDET ;
  1.  ; For each Clinic/Visit Type/AR Account/Dsch Svc (Standard) do...
  1.  I $Y>(IOSL-5) D HD Q:$G(BAR("F1"))
  1.  S BARTMP=$G(^TMP($J,"BAR-NBR",BAR("SUB1"),BAR("SUB2")))
  1.  S BARNAME=BAR("SUB2")
  1.  W !,$E(BARNAME,1,19)            ; clinic/vis typ
  1.  D STNDLINE
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. STNDLTOT ;
  1.  ; Visit Location Totals (Standard format)
  1.  Q:$G(BAR("F1"))
  1.  W !,BARDASH,!
  1.  S BARTMP=$G(^TMP($J,"BAR-NBR",BAR("SUB1")))
  1.  W "*** VISIT Loc Total"
  1.  D STNDLINE
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. STNDTOT ;
  1.  ; Report Totals (Standard format)
  1.  Q:$G(BAR("F1"))
  1.  W !,BAREQUAL,!
  1.  S BARTMP=$G(^TMP($J,"BAR-NBR"))
  1.  W "***** REPORT TOTAL"
  1.  D STNDLINE
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. SUMMARY ;
  1.  ; Print report if user selected SORT CRITERIA Billing Entity or
  1.  ; Allowance Category and Report Type w/o payers
  1.  ;
  1.  D HDB
  1.  I '$D(^TMP($J,"BAR-NBRT")) D  Q           ; No data - quit
  1.  . W !!!!!?25,"*** NO DATA TO PRINT ***"
  1.  . D EOP^BARUTL(0)
  1.  ;
  1.  S BARHOLD("SUB1")=$O(^TMP($J,"BAR-NBRT",""))
  1.  S BAR("SUB1")=""
  1.  F  S BAR("SUB1")=$O(^TMP($J,"BAR-NBRT",BAR("SUB1"))) Q:BAR("SUB1")=""  D SUMLOC  Q:$G(BAR("F1"))
  1.  W !
  1.  D SUMTOT
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. SUMLOC ;
  1.  ; For each visit location (Summary format) do...
  1.  I BAR("SUB1")'=BARHOLD("SUB1") D HD
  1.  Q:$G(BAR("F1"))
  1.  S BARHOLD("SUB1")=BAR("SUB1")
  1.  I '$D(BARY("LOC")) W !,"*** VISIT Location: ",BAR("SUB1"),!
  1.  S BAR("SUB3")=""
  1.  F  S BAR("SUB3")=$O(^TMP($J,"BAR-NBRT",BAR("SUB1"),BAR("SUB3"))) Q:BAR("SUB3")=""  D SUMDET Q:$G(BAR("F1"))
  1.  W !
  1.  D SUMLTOT
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. SUMDET ;
  1.  QUIT
  1.  ; ********************************************************************
  1.  ;
  1. DETAIL ;
  1.  ; Print report if user selected SORT CRITERIA Billing Entity or
  1.  ; Allowance Category and Report Type with payers
  1.  D HDB
  1.  I '$D(^TMP($J,"BAR-NBRT")) D  Q           ; No data - quit
  1.  . W !!!!!?25,"*** NO DATA TO PRINT ***"
  1.  . D EOP^BARUTL(0)
  1.  ;
  1.  S BARHOLD("SUB1")=$O(^TMP($J,"BAR-NBRT",""))
  1.  S BAR("SUB1")=""
  1.  F  S BAR("SUB1")=$O(^TMP($J,"BAR-NBRT",BAR("SUB1"))) Q:BAR("SUB1")=""  D DETLOC  Q:$G(BAR("F1"))
  1.  W !
  1.  D SUMTOT
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. DETLOC ;
  1.  ; For each visit location (Detail format) do...
  1.  I BAR("SUB1")'=BARHOLD("SUB1") D HD
  1.  Q:$G(BAR("F1"))
  1.  S BARHOLD("SUB1")=BAR("SUB1")
  1.  I '$D(BARY("LOC")) W !,"*** VISIT Location: ",BAR("SUB1"),!
  1.  S BAR("SUB3")=""
  1.  F  S BAR("SUB3")=$O(^TMP($J,"BAR-NBRT",BAR("SUB1"),BAR("SUB3"))) Q:BAR("SUB3")=""  D DETBEAL Q:$G(BAR("F1"))
  1.  D SUMLTOT
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. DETBEAL ;
  1.  ; For each Billing Entity/Allowance category (Detail format) do...
  1.  W !,BAR("SUB3")
  1.  S BAR("SUB4")=""
  1.  F  S BAR("SUB4")=$O(^TMP($J,"BAR-NBRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"))) Q:BAR("SUB4")=""  D DETDET Q:$G(BAR("F1"))
  1.  W !
  1.  D BEALTOT
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. DETDET ;
  1.  Q  ;
  1.  ; ********************************************************************
  1.  ;
  1. BILL ;
  1.  ; Summary / by payer / By Bill
  1.  ; Print report if user selected SORT CRITERIA Billing Entity or
  1.  ; Allowance Category and Report Type with payers AND bills
  1.  D HDB
  1.  I '$D(^TMP($J,"BAR-NBRT")) D  Q           ; No data - quit
  1.  . W !!!!!?25,"*** NO DATA TO PRINT ***"
  1.  . D EOP^BARUTL(0)
  1.  ;
  1.  S BARHOLD("SUB1")=$O(^TMP($J,"BAR-NBRT",""))
  1.  S BAR("SUB1")=""  F  S BAR("SUB1")=$O(^TMP($J,"BAR-NBRT",BAR("SUB1"))) Q:BAR("SUB1")=""  D BILLLOC  Q:$G(BAR("F1"))
  1.  W !
  1.  D SUMTOT
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. BILLLOC ;
  1.  ; For each visit location (Detail format) do...
  1.  I BAR("SUB1")'=BARHOLD("SUB1") D HD
  1.  Q:$G(BAR("F1"))
  1.  S BARHOLD("SUB1")=BAR("SUB1")
  1.  I '$D(BARY("LOC")) W !,"*** VISIT Location: ",BAR("SUB1"),!
  1.  S BAR("SUB3")=""
  1.  F  S BAR("SUB3")=$O(^TMP($J,"BAR-NBRT",BAR("SUB1"),BAR("SUB3"))) Q:BAR("SUB3")=""  D BILLBEAL Q:$G(BAR("F1"))
  1.  W !
  1.  D SUMLTOT
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. BILLBEAL ;
  1.  ; For each Billing Entity/Allowance category (Detail format) do...
  1.  W $$EN^BARVDF("HIN")
  1.  ;;;W !,$$CJ^XLFSTR(BAR("SUB3"),IOM),! ;P.OTT
  1.  W $$EN^BARVDF("HIF")
  1.  S BAR("SUB4")=""
  1.  F  S BAR("SUB4")=$O(^TMP($J,"BAR-NBRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"))) Q:BAR("SUB4")=""  D BILLACCT Q:$G(BAR("F1"))
  1.  D BEALTOT
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. BILLACCT ;
  1.  ; For each A/R Account (Bill detail) do ...
  1.  S BAR("SUB5")=""
  1.  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"))
  1.  D ACCTTOT
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. BILLDET ;
  1.  ; For each Bill (Bill Format) do...
  1.  I $Y>(IOSL-5) D HD Q:$G(BAR("F1"))
  1.  S BARTMP=$G(^TMP($J,"BAR-NBRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"),BAR("SUB5")))
  1.  ;
  1.  I BARMODE="D" D  Q  ;DETAILED
  1.  . D BILLLOOP
  1.  . D BILLLINE
  1.  . ;D STNDLINE
  1.  . W !
  1.  . Q
  1.  S BARTMP=$G(^TMP($J,"BAR-NBRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"),BAR("SUB5")))
  1.  W !,$P(BAR("SUB5"),"-")  ;SUMMARY FOR BILL
  1.  D STNDLINE
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. 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
  1.  ;TO: ^BILLED^BALANCE^INS^PAT^
  1.  N BARBILL,BARBL,BARTMP1,BARTMP2,BARD1,BARD2,BARD3,BARD4,BARCNT
  1.  S BARBILL=$P(BAR("SUB5"),"-")  ; p.ott BILL # PART1
  1.  S BARBL="0" F  S BARBL=$O(^TMP($J,"BAR-NBR9",BARBILL,BARBL)) Q:+BARBL=0  D  Q:$G(BAR("F1"))
  1.  . S BARTMP1=$G(^TMP($J,"BAR-NBR9",BARBILL,BARBL))
  1.  . S BARFULL=$P(BARTMP1,"^",1)
  1.  . S BARD1=$P(BARTMP1,"^",2) ;AMT BILLED
  1.  . S BARD4=$P(BARTMP1,"^",3) ;BALANCE
  1.  . W !,BARFULL
  1.  . S BARCNT=0
  1.  . S BARTR="0" F  S BARTR=$O(^TMP($J,"BAR-NBR9",BARBILL,BARBL,BARTR)) Q:+BARTR=0  D  Q:$G(BAR("F1"))
  1.  . . S BARTMP2=$G(^TMP($J,"BAR-NBR9",BARBILL,BARBL,BARTR))
  1.  . . ;S BARTRT=$P(BARTMP2,"^",3) I BARTRT'=40 Q  ;W !,BARTR," NO PAYMENT" QUIT
  1.  . . S BARFLG=$P(BARTMP2,"^",8),BARAMT=$P(BARTMP2,"^",7)
  1.  . . S BARD2=0,BARD3=0
  1.  . . S BARD2=BARAMT I BARFLG S BARD3=BARAMT,BARD2=0 ;PAT OR INS?
  1.  . . S BARCNT=BARCNT+1 ;I BARCNT>1 W !
  1.  . . W ! ;,BARTR
  1.  . . I BARD3>0 W ?10,$$MDY(BARTR\1) ;DISPLAY DATE ONLY FOR PAT PAYMENTS (!)
  1.  . . D STNDLN2(BARBL)
  1.  . I BARCNT=0 D
  1.  . . W ?36,$J($FN(0,",",2),14)      ; INS
  1.  . . W ?51,$J($FN(0,",",2),14)      ; PAT
  1.  . Q
  1.  W !,BARDASH
  1.  ;W !,"*** BILL ",BARBILL," Total"
  1.  W !,"*** ",BARBILL," Total"
  1.  Q
  1. STNDLN2(BARBL) ;
  1.  I BARCNT=1 W ?20,$J($FN(BARD1,",",2),15)     ; Amount billed
  1.  W ?36,$J($FN(BARD2,",",2),14)      ; INS
  1.  W ?51,$J($FN(BARD3,",",2),14)      ; PAT
  1.  I BARFLG<0 W "*" ;1/14/2014
  1.  I BARCNT=1 W ?66,$J($FN(BARD4,",",2),13)     ; 
  1.  Q
  1. SUMTOT ;
  1.  ; Report totals (summary, detail, bill)
  1.  Q:$G(BAR("F1"))
  1.  S BARTMP=$G(^TMP($J,"BAR-NBRT"))
  1.  W BAREQUAL,!
  1.  W "***** REPORT Total"
  1.  D STNDLINE
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. SUMLTOT ;
  1.  ; Visit Location totals (summary, detail, bill)
  1.  Q:$G(BAR("F1"))
  1.  S BARTMP=$G(^TMP($J,"BAR-NBRT",BAR("SUB1")))
  1.  W BARDASH,!
  1.  W "*** VISIT Loc Total"
  1.  D STNDLINE
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. BEALTOT ;
  1.  ; Billing Entity / Allowance Category totals (detail, bill)
  1.  Q  ;P.OTT
  1.  Q:$G(BAR("F1"))
  1.  S BARTMP=$G(^TMP($J,"BAR-NBRT",BAR("SUB1"),BAR("SUB3")))
  1.  W BARDASH,!
  1.  W " ** Total"
  1.  D STNDLINE
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. ACCTTOT ;
  1.  ; A/R  Account totals (bill)
  1.  Q  ;P.OTT
  1.  Q:$G(BAR("F1"))
  1.  S BARTMP=$G(^TMP($J,"BAR-NBRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4")))
  1.  W !,BARDASH,!
  1.  W "  * A/R Acct Total"
  1.  D STNDLINE
  1.  W !
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. BILLLINE ;SUM FOR BILL (XXXX (A,B,C)
  1.  N BARBILL,BARTMP
  1.  S BARBILL=$P(BAR("SUB5"),"-")  ; p.ott BILL # PART1
  1.  S BARTMP=$G(^TMP($J,"BAR-NBR9",BARBILL))
  1.  W ?20,$J($FN($P(BARTMP,U),",",2),15)        ; Amount billed
  1.  W ?36,$J($FN($P(BARTMP,U,2),",",2),14)      ; Patient Payments
  1.  W ?51,$J($FN($P(BARTMP,U,3),",",2),14)      ; insurance payments
  1.  W ?66,$J($FN($P(BARTMP,U,4),",",2),13)      ; balance
  1.  Q
  1. STNDLINE ;
  1.  W ?20,$J($FN($P(BARTMP,U),",",2),15)        ; Amount billed
  1.  W ?36,$J($FN($P(BARTMP,U,2),",",2),14)      ; Patient Payments
  1.  W ?51,$J($FN($P(BARTMP,U,3),",",2),14)      ; insurance payments
  1.  W ?66,$J($FN($P(BARTMP,U,4),",",2),13)      ; balance
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. B13(BARBL) ;
  1.  Q
  1. B15(BARBL) ;
  1.  Q
  1. HD ; EP
  1.  D PAZ^BARRUTL
  1.  I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S BAR("F1")=1 Q
  1.  ; -------------------------------
  1.  ;
  1. HDB ; EP
  1.  ; Page and column header
  1.  S BAR("PG")=BAR("PG")+1
  1.  S BAR("I")=""
  1.  D WHD^BARRHD                   ; Report header
  1.  D HDRBAR(BARMODE) ;12/31/2013
  1.  S $P(BAR("DASH"),"=",$S($D(BAR(133)):132,1:81))=""
  1.  W !,BAR("DASH"),!
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. XIT ;
  1.  K ^TMP($J,"BAR-NBR")
  1.  K ^TMP($J,"BAR-NBRT")
  1.  Q
  1. HDRBAR(BARMODE) ;
  1.  I BARMODE="D" D  Q
  1.  . W !,"Bill",?10,"Pt Payment",?29,"Amount",?43,"Insurance",?58,"Patient"
  1.  . W !,"Number",?9,"Posted Date",?29,"Billed",?43,"Payment",?58,"Payment",?72,"Balance"
  1.  I BARMODE="S" D  Q
  1.  . W !,"Bill",?29,"Amount",?43,"Insurance",?58,"Patient"
  1.  . W !,"Number",?29,"Billed",?43,"Payment",?58,"Payment",?72,"Balance"
  1.  Q
  1. MDY(BARD) ;  format Date from FM to MM/DD/YYYY
  1.  N BARFMMM,BARFMDD,BARFMYY
  1.  S BARFMMM=$E(BARD,4,5)
  1.  S BARFMDD=$E(BARD,6,7)
  1.  S BARFMYY=$E(BARD,1,3)+1700
  1.  Q BARFMMM_"/"_BARFMDD_"/"_BARFMYY
  1.  ;----------EOR--------------