BARRNBRA ; IHS/SD/POT - Non Ben Payment Report ; 08/20/2008
;;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 BAR*1.8*24
; IHS/SD/POT 04/07/14 FIXED CHECK FOR ELIGIBILITY STATUS FROM PAT FILE BAR*1.8*24
Q
; **
;
EN ; EP
K BARY,BAR
S BARP("RTN")="BARRNBRA"
S BARY("RTYP")=1,BARY("RTYP","NM")="DETAIL"
S BAR("PRIVACY")=1 ; Privacy act applies
S BARY("SORT")="" ; Init value to prevent <UNDEF>
D:'$D(BARUSR) INIT^BARUTL ; Set A/R basic variable
S BAR("LOC")=$$GET1^DIQ(90052.06,DUZ(2),16) ; BILLING or VISIT
I BAR("LOC")="" S BAR("LOC")="VISIT"
S DEBUG=0
ASK1 D ASKAGAI1^BARRNBRS
I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q
I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q
I $D(BARY("RTYP")) S BAR("HD",0)=BARY("RTYP","NM")_" "_BARMENU
E S BAR("HD",0)=BARMENU
;-
I $G(BARY("SORT"))="C" S BARY("SORT","NM")="Clinic"
I $G(BARY("SORT"))="V" S BARY("SORT","NM")="Visit type"
I $G(BARY("DT"))="V" S BARY("DT","NM")="Visit"
I $G(BARY("DT"))="T" S BARY("DT","NM")="Transaction"
I '$D(BARY("DT")) D ;
. S BARY("DT")="",BARY("DT",1)="",BARY("DT",2)=""
S BARY("TYP")="^N^"
S BARY("TYP","NM")="NON-BENEFICIARY"
;-
D SETHDR ; Build header array
S BARQ("RC")="COMPUTE^BARRNBRA" ; Build tmp global with data
S BARQ("RP")="PRINT^BARRNBRB" ; Print reports from tmp global
S BARQ("NS")="BAR" ; Namespace for variables
S BARQ("RX")="POUT^BARRUTL" ; Clean-up routine
D ^BARDBQUE ; Double queuing
D PAZ^BARRUTL ; Press return to continue
Q
; **
SETHDR ;
; Build header array
S BAR("OPT")="NBR"
S BAR("LVL")=0
S BARMODE="S"
I $G(BARY("RTYP"))=1 S BARMODE="D"
I BARMODE="D" S BAR("HD",0)="Non-beneficiary Detailed Report"
I BARMODE="S" S BAR("HD",0)="Non-beneficiary Summary Report"
D DT^BARRHD
S BAR("LVL")=$G(BAR("LVL"))+1
S BAR("HD",BAR("LVL"))=""
S BAR("TXT")="ALL"
I $D(BARY("LOC")) S BAR("TXT")=$P(^DIC(4,BARY("LOC"),0),U)
I BAR("LOC")="BILLING" D
. S BAR("TXT")=BAR("TXT")_" Visit location(s) under "
. S BAR("TXT")=BAR("TXT")_$P(^DIC(4,DUZ(2),0),U)
. S BAR("TXT")=BAR("TXT")_" Billing Location"
E S BAR("TXT")=BAR("TXT")_" Visit location(s) regardless of Billing Location"
I $D(BARY("PAT")) S BAR("TXT")=BAR("TXT")_$C(10,13)_"for "_BARY("PAT","NM")
S BAR("CONJ")="at "
D CHK^BARRHD
Q
; **
;
COMPUTE ; EP
S BAR("SUBR")="BAR-NBR"
K ^TMP($J,"BAR-NBR")
K ^TMP($J,"BAR-NBR9")
K ^TMP($J,"BAR-NBRT")
K ^TMP($J,"BAR-BAR-NBR")
I BAR("LOC")="BILLING" ;**************
D TRANS,MAIN Q
Q
; *********************************************************************
;
TRANS ;EP for Looping thru Transaction File
I $G(BARY("PAT"))="" I BARY("DT")="T" S BARP("X")="B" D Q ;NO PAT - LOOP TXD FROM-TO
. S BARP("DT")=BARY("DT",1)-.5 F S BARP("DT")=$O(^BARTR(DUZ(2),BARP("X"),BARP("DT"))) Q:'BARP("DT")!(BARP("DT")>(BARY("DT",2)+.5)) D
. . S BARTR=0 F S BARTR=$O(^BARTR(DUZ(2),BARP("X"),BARP("DT"),BARTR)) Q:'BARTR D DATA
;-------------------------
I $G(BARY("PAT"))="" I BARY("DT")="V" D Q ;NO PAT - LOOP ALL TXD
. S BARP("DT")=0 F S BARP("DT")=$O(^BARTR(DUZ(2),BARP("DT"))) Q:'+BARP("DT") S BARTR=BARP("DT") D DATA
;-------------------------
I BARY("DT")="T" S BARP("X")="AF" D Q ;PAT
. S BARP("DT")=BARY("DT",1)-.5 F S BARP("DT")=$O(^BARTR(DUZ(2),BARP("X"),BARY("PAT"),BARP("DT"))) Q:'BARP("DT")!(BARP("DT")>(BARY("DT",2)+.5)) D
. . S BARTR=BARP("DT") D DATA
;--------------------------
I BARY("DT")="V" S BARP("X")="AF" D Q
. S BARP("DT")=0 F S BARP("DT")=$O(^BARTR(DUZ(2),BARP("X"),BARY("PAT"),BARP("DT"))) Q:+BARP("DT")=0 D
. . S BARTR=BARP("DT") D DATA
;--
Q
; **
DATA ; Gather data for transactions found in TRANS
; S ^TMP($J,"BAR-NBR9",YBARBL,BARBL)
; S ^TMP($J,"BAR-NBR9",YBARBL,BARBL,BARTR)
;
S BARP("HIT")=0
S X=$$ISNONBEN(BARTR) I 'X Q
D CHKTRANS^BARRNBRE(BARTR)
I 'BARP("HIT") Q ;
S BARTEST=","_$P($G(^BARTR(DUZ(2),BARTR,1)),U)_","
I BARTEST=",," Q
;I ",115,116,117,118,"[BARTEST D Q
I ",49,40,"'[BARTEST Q
;
I $$ISERR(BARTR) Q ;ERROR
S BARBL=$P($G(^BARTR(DUZ(2),BARTR,0)),U,4) ;
S BARTR(0)=$G(^BARTR(DUZ(2),BARTR,0)) ; A/R Transaction 0 node
S BARTR(1)=$G(^BARTR(DUZ(2),BARTR,1)) ; A/R Transaction 1 node
S BARTR("T")=$P(BARTR(1),U) ; Transaction type
S BARTR("DT")=$P(BARTR(0),U) ; Transaction date/time
S BARCR=$P(BARTR(0),"^",2)
S BARDB=$P(BARTR(0),"^",3)
S BARTRACC=$P(BARTR(0),U,6) ;ACCNT
S BARPAT=$P(BAR(10),U,1) ;PAT FROM BAR 1;1
S BARFLG=0
I BARTRACC]"" I $G(^BARAC(DUZ(2),BARTRACC,0))[";AUPNPAT" I +$G(^BARAC(DUZ(2),BARTRACC,0))=BARPAT S BARFLG=1 ;BILLED TO PAT
I BARTRACC]"" I $G(^BARAC(DUZ(2),BARTRACC,0))[";AUPNPAT" I +$G(^BARAC(DUZ(2),BARTRACC,0))'=BARPAT S BARFLG=-1 ;BILLED TO other PAT (in err) 1/14/2014
;40 - payment
;19 - refund
;20 - payment credit
S BARPAY=0 I BARTR("T")=40 S BARPAY=$$VAL^XBDIQ1(90050.03,BARTR,3.5) ;PAYMENT #3.6
S BARADJ=0
I "^3^4^13^14^15^16^"[("^"_BARTR("T")_"^") S BARADJ=$$VAL^XBDIQ1(90050.03,BARTR,3.5) ;ADJ #3.7 ;
S BARPAYAD=BARPAY+BARADJ
;BARFLG=-1 IF PAT WAS CHARGED IN ERR
;BARFLG=1 IF PAT WAS CHARGED
;BARFLG=0 IF INS WAS CHARGED
I BARTR("T")=49 Q ;1/13/2014
S TMP=BARTR("DT")_"^"_BARTR("T")_"^"_BARCR_"^"_BARDB_"^"_BARPAY_"^"_BARADJ_"^"_BARPAYAD_"^"_BARFLG
S YBARBL=+$P($G(^BARBL(DUZ(2),BARBL,0)),U,1) ;1ST PART OF BILL #
S ^TMP($J,"BAR-NBR9",YBARBL,BARBL,BARTR)=TMP
S ^TMP($J,"BAR-NBR9",YBARBL,BARBL)=$P(BAR(0),U,1)_"^"_$P(BAR(0),U,13)_"^"_$P(BAR(0),U,15)_"^^^"_BARPAT
Q
;---------------------------
MAIN ;^TMP($J,"BAR-NBR9",-->^TMP($J,"BAR-NBRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"),BAR("SUB5")),U,I)
;
; BAR("SUB1") = Visit Location
; BAR("SUB2") = Clinic / visit type
; BAR("SUB3") = N/A
; BAR("SUB4") = N/A
; BAR("SUB5") = A/R Bill
; OUTPUT DATA - NOT USED
; BAR(1) = Billed Amount
; BAR(2) = Insurance Payment
; BAR(3) = Patient Payment
; BAR(4) = Balance
; BAR(5) = Transaction Date
; -------------------------------
;
F I=1:1:5 S BAR(I)=0
F I=1:1:5 K BAR("SUB"_I)
N BARX,BAR,BARXTR,BARTR,BARDDD
S BARY="" F S BARY=$O(^TMP($J,"BAR-NBR9",BARY)) Q:BARY="" D
. S BARX="0" F S BARX=$O(^TMP($J,"BAR-NBR9",BARY,BARX)) Q:BARX="" D ADDUPTR^BARRNBRF(BARY,BARX)
S BARY="" F S BARY=$O(^TMP($J,"BAR-NBR9",BARY)) Q:BARY="" D ADDUPBL^BARRNBRF(BARY)
S BARX="" F S BARX=$O(^TMP($J,"BAR-NBR9",BARX)) Q:BARX="" D MAIN2(BARX)
D 100^BARRNBRF
D 110^BARRNBRF
Q
;
MAIN2(YBARBL) ;YBARBL IS THE 1ST PART OF A BILL
N PATPAY,INSPAY,BARDATE,BARBL
F I=1:1:5 S BAR(I)=0
S BARBL=$O(^TMP($J,"BAR-NBR9",YBARBL,"0")) I BARBL="" Q
S BARDATE=+^TMP($J,"BAR-NBR9",YBARBL,BARBL)
D EXTRACT(BARBL) ;GET 'C' AND 'L'
S BAR("SUB1")=$$GET1^DIQ(9999999.06,BARTR("L"),.01) ;Visit Location
S:BAR("SUB1")="" BAR("SUB1")="No Visit Location"
I BARY("SORT")="C" D
. S BAR("SUB2")=BAR("C") ;Clinic / visit type
. I BAR("SUB2")]"",BAR("SUB2")'=99999 S BAR("SUB2")=$$GET1^DIQ(40.7,BAR("SUB2"),.01)
. I BAR("SUB2")=""!(BAR("SUB2")=99999) S BAR("SUB2")="No Clinic Type"
. D STANDARD
I BARY("SORT")="V" D
. S BAR("SUB2")=BAR("V") ;Clinic / visit type
. I BAR("SUB2")]"",BAR("SUB2")'=99999 S BAR("SUB2")=$$GET1^DIQ(9002274.8,BAR("SUB2"),.01)
. I BAR("SUB2")=""!(BAR("SUB2")=99999) S BAR("SUB2")="No Visit Type"
. D STANDARD
S BAR("SUB3")=" " ;N/A
S BAR("SUB4")=" " ;N/A
S BAR("SUB5")=YBARBL
I BAR("SUB5")="" Q
D DETAIL
D BILL
D SUMMARY
Q
; *
STANDARD ;
; Temp global for SORT CRITERIA Clinic or Visit or A/R Account
; or Discharge Service
; Detail Lines
NEW I
S BARHLD=$G(^TMP($J,"BAR-NBR",BAR("SUB1"),BAR("SUB2")))
F I=1:1:4 S $P(^TMP($J,"BAR-NBR",BAR("SUB1"),BAR("SUB2")),U,I)=$P(BARHLD,U,I)+BAR(I)
;
; Visit Location Totals
S BARHLD=$G(^TMP($J,"BAR-NBR",BAR("SUB1")))
F I=1:1:4 S $P(^TMP($J,"BAR-NBR",BAR("SUB1")),U,I)=$P(BARHLD,U,I)+BAR(I)
; Report Total
S BARHLD=$G(^TMP($J,"BAR-NBR"))
F I=1:1:4 S $P(^TMP($J,"BAR-NBR"),U,I)=$P(BARHLD,U,I)+BAR(I)
S ^TMP($J,"BAR-NBR",BAR("SUB1"),BAR("SUB2"),YBARBL)=""
Q
; *
;
SUMMARY ;
; Temp global for SORT CRITERIA Allowance Category or Billing Entity
; and Report Type Summarize.
;
; Detail Lines
NEW I
S BARHLD=$G(^TMP($J,"BAR-NBRT",BAR("SUB1"),BAR("SUB3")))
F I=1:1:4 S $P(^TMP($J,"BAR-NBRT",BAR("SUB1"),BAR("SUB3")),U,4)=$P(BARHLD,U,I)+BAR(I)
;
; Visit Location Totals
S BARHLD=$G(^TMP($J,"BAR-NBRT",BAR("SUB1")))
F I=1:1:4 S $P(^TMP($J,"BAR-NBRT",BAR("SUB1")),U,I)=$P(BARHLD,U,I)+BAR(I)
S $P(^TMP($J,"BAR-NBRT",BAR("SUB1")),U,5)=BARTR("L")
;
; Report Total
S BARHLD=$G(^TMP($J,"BAR-NBRT"))
F I=1:1:4 S $P(^TMP($J,"BAR-NBRT"),U,I)=$P(BARHLD,U,I)+BAR(I)
Q
; *
;
DETAIL ;
; Temp global for SORT CRITERIA Allowance Category or Billing Entity
; and Report Type Summarize by payor w/in.
;
; Detail Lines
NEW I
S BARHLD=$G(^TMP($J,"BAR-NBRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4")))
F I=1:1:4 S $P(^TMP($J,"BAR-NBRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4")),U,I)=$P(BARHLD,U,I)+BAR(I)
Q
; *
;
BILL ;
; Temp global for SORT CRITERIA Allowance Category or Billing Entity
; and Report Type Summarize by BILL w/in payor w/in.
;
; Detail Lines
S BARHLD=$G(^TMP($J,"BAR-NBRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"),BAR("SUB5")))
F I=1:1:4 S $P(^TMP($J,"BAR-NBRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"),BAR("SUB5")),U,I)=$P(BARHLD,U,I)+BAR(I)
S $P(^TMP($J,"BAR-NBRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"),BAR("SUB5")),U,5)=BARDATE
Q
; *
;
XIT ;
D ^BARVKL0
Q
ISERR(BARTRDT) ;
N BARTR,BARTTYP
D ENP^XBDIQ1(90050.03,BARTRDT,"101;102;103","BARTR(","I")
S BARTTYP=BARTR(101,"I")
I BARTTYP'=39,BARTTYP'=43,BARTTYP'=40,BARTTYP'=49,BARTTYP'=107 Q 0
I BARTR(103)["ERROR" Q 1
Q 0
N BAR0,BAR1
S BAR0=$G(^BARBL(DUZ(2),BARBL,0)) ; A/R Bill 0 node
S BAR1=$G(^BARBL(DUZ(2),BARBL,1)) ; A/R Bill 1 node
S BAR("V")=$P(BAR1,U,14) ; Visit type (3P Visit Type)
S BARTR("L")=$P(BAR1,U,8) ; Visit location (A/R Parent/Sat)
S BARTR("D")=$P(BAR1,U,2) ; DOS Begin
S BARTR("C")=$P(BAR1,U,12) ; Clinic (Clinic Stop File)
Q
ISNONBEN(BARTR) ;BAR*1.8*24
N BAR1,BARPAT,BARTR0,BARBL
S BARTR0=$G(^BARTR(DUZ(2),BARTR,0))
S BARBL=$P(BARTR0,U,4) I BARBL="" Q 0
S BAR1=$G(^BARBL(DUZ(2),BARBL,1)) ; A/R Bill 1 node
S BARPAT=$P(BAR1,U,1) ; Patient (Patient file)
I BARPAT="" Q 0 ; <SUBSCRIPT>ISNONBEN+6^BARRNBRA 4/8/14
I $P($G(^AUPNPAT(BARPAT,11)),U,12)="I" Q 1 ;Not eligible = > is non-ben
Q 0
;------EOR----------
BARRNBRA ; IHS/SD/POT - Non Ben Payment Report ; 08/20/2008
+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 BAR*1.8*24
+4 ; IHS/SD/POT 04/07/14 FIXED CHECK FOR ELIGIBILITY STATUS FROM PAT FILE BAR*1.8*24
+5 QUIT
+6 ; **
+7 ;
EN ; EP
+1 KILL BARY,BAR
+2 SET BARP("RTN")="BARRNBRA"
+3 SET BARY("RTYP")=1
SET BARY("RTYP","NM")="DETAIL"
+4 ; Privacy act applies
SET BAR("PRIVACY")=1
+5 ; Init value to prevent <UNDEF>
SET BARY("SORT")=""
+6 ; Set A/R basic variable
IF '$DATA(BARUSR)
DO INIT^BARUTL
+7 ; BILLING or VISIT
SET BAR("LOC")=$$GET1^DIQ(90052.06,DUZ(2),16)
+8 IF BAR("LOC")=""
SET BAR("LOC")="VISIT"
+9 SET DEBUG=0
ASK1 DO ASKAGAI1^BARRNBRS
+1 IF $DATA">DATA">DATA">DATA(DTOUT)!$DATA">DATA">DATA">DATA(DUOUT)!$DATA">DATA">DATA">DATA(DIROUT)
QUIT
+2 IF $DATA">DATA">DATA">DATA(DTOUT)!$DATA">DATA">DATA">DATA(DUOUT)!$DATA">DATA">DATA">DATA(DIROUT)
QUIT
+3 IF $DATA(BARY("RTYP"))
SET BAR("HD",0)=BARY("RTYP","NM")_" "_BARMENU
+4 IF '$TEST
SET BAR("HD",0)=BARMENU
+5 ;-
+6 IF $GET(BARY("SORT"))="C"
SET BARY("SORT","NM")="Clinic"
+7 IF $GET(BARY("SORT"))="V"
SET BARY("SORT","NM")="Visit type"
+8 IF $GET(BARY("DT"))="V"
SET BARY("DT","NM")="Visit"
+9 IF $GET(BARY("DT"))="T"
SET BARY("DT","NM")="Transaction"
+10 ;
IF '$DATA(BARY("DT"))
Begin DoDot:1
+11 SET BARY("DT")=""
SET BARY("DT",1)=""
SET BARY("DT",2)=""
End DoDot:1
+12 SET BARY("TYP")="^N^"
+13 SET BARY("TYP","NM")="NON-BENEFICIARY"
+14 ;-
+15 ; Build header array
DO SETHDR
+16 ; Build tmp global with data
SET BARQ("RC")="COMPUTE^BARRNBRA"
+17 ; Print reports from tmp global
SET BARQ("RP")="PRINT^BARRNBRB"
+18 ; Namespace for variables
SET BARQ("NS")="BAR"
+19 ; Clean-up routine
SET BARQ("RX")="POUT^BARRUTL"
+20 ; Double queuing
DO ^BARDBQUE
+21 ; Press return to continue
DO PAZ^BARRUTL
+22 QUIT
+23 ; **
SETHDR ;
+1 ; Build header array
+2 SET BAR("OPT")="NBR"
+3 SET BAR("LVL")=0
+4 SET BARMODE="S"
+5 IF $GET(BARY("RTYP"))=1
SET BARMODE="D"
+6 IF BARMODE="D"
SET BAR("HD",0)="Non-beneficiary Detailed Report"
+7 IF BARMODE="S"
SET BAR("HD",0)="Non-beneficiary Summary Report"
+8 DO DT^BARRHD
+9 SET BAR("LVL")=$GET(BAR("LVL"))+1
+10 SET BAR("HD",BAR("LVL"))=""
+11 SET BAR("TXT")="ALL"
+12 IF $DATA(BARY("LOC"))
SET BAR("TXT")=$PIECE(^DIC(4,BARY("LOC"),0),U)
+13 IF BAR("LOC")="BILLING"
Begin DoDot:1
+14 SET BAR("TXT")=BAR("TXT")_" Visit location(s) under "
+15 SET BAR("TXT")=BAR("TXT")_$PIECE(^DIC(4,DUZ(2),0),U)
+16 SET BAR("TXT")=BAR("TXT")_" Billing Location"
End DoDot:1
+17 IF '$TEST
SET BAR("TXT")=BAR("TXT")_" Visit location(s) regardless of Billing Location"
+18 IF $DATA(BARY("PAT"))
SET BAR("TXT")=BAR("TXT")_$CHAR(10,13)_"for "_BARY("PAT","NM")
+19 SET BAR("CONJ")="at "
+20 DO CHK^BARRHD
+21 QUIT
+22 ; **
+23 ;
COMPUTE ; EP
+1 SET BAR("SUBR")="BAR-NBR"
+2 KILL ^TMP($JOB,"BAR-NBR")
+3 KILL ^TMP($JOB,"BAR-NBR9")
+4 KILL ^TMP($JOB,"BAR-NBRT")
+5 KILL ^TMP($JOB,"BAR-BAR-NBR")
+6 ;**************
IF BAR("LOC")="BILLING"
+7 DO TRANS
DO MAIN
QUIT
+8 QUIT
+9 ; *********************************************************************
+10 ;
TRANS ;EP for Looping thru Transaction File
+1 ;NO PAT - LOOP TXD FROM-TO
IF $GET(BARY("PAT"))=""
IF BARY("DT")="T"
SET BARP("X")="B"
Begin DoDot:1
+2 SET BARP("DT")=BARY("DT",1)-.5
FOR
SET BARP("DT")=$ORDER(^BARTR(DUZ(2),BARP("X"),BARP("DT")))
IF 'BARP("DT")!(BARP("DT")>(BARY("DT",2)+.5))
QUIT
Begin DoDot:2
+3 SET BARTR=0
FOR
SET BARTR=$ORDER(^BARTR(DUZ(2),BARP("X"),BARP("DT"),BARTR))
IF 'BARTR
QUIT
DO DATA
End DoDot:2
End DoDot:1
QUIT
+4 ;-------------------------
+5 ;NO PAT - LOOP ALL TXD
IF $GET(BARY("PAT"))=""
IF BARY("DT")="V"
Begin DoDot:1
+6 SET BARP("DT")=0
FOR
SET BARP("DT")=$ORDER(^BARTR(DUZ(2),BARP("DT")))
IF '+BARP("DT")
QUIT
SET BARTR=BARP("DT")
DO DATA
End DoDot:1
QUIT
+7 ;-------------------------
+8 ;PAT
IF BARY("DT")="T"
SET BARP("X")="AF"
Begin DoDot:1
+9 SET BARP("DT")=BARY("DT",1)-.5
FOR
SET BARP("DT")=$ORDER(^BARTR(DUZ(2),BARP("X"),BARY("PAT"),BARP("DT")))
IF 'BARP("DT")!(BARP("DT")>(BARY("DT",2)+.5))
QUIT
Begin DoDot:2
+10 SET BARTR=BARP("DT")
DO DATA
End DoDot:2
End DoDot:1
QUIT
+11 ;--------------------------
+12 IF BARY("DT")="V"
SET BARP("X")="AF"
Begin DoDot:1
+13 SET BARP("DT")=0
FOR
SET BARP("DT")=$ORDER(^BARTR(DUZ(2),BARP("X"),BARY("PAT"),BARP("DT")))
IF +BARP("DT")=0
QUIT
Begin DoDot:2
+14 SET BARTR=BARP("DT")
DO DATA
End DoDot:2
End DoDot:1
QUIT
+15 ;--
+16 QUIT
+17 ; **
DATA ; Gather data for transactions found in TRANS
+1 ; S ^TMP($J,"BAR-NBR9",YBARBL,BARBL)
+2 ; S ^TMP($J,"BAR-NBR9",YBARBL,BARBL,BARTR)
+3 ;
+4 SET BARP("HIT")=0
+5 SET X=$$ISNONBEN(BARTR)
IF 'X
QUIT
+6 DO CHKTRANS^BARRNBRE(BARTR)
+7 ;
IF 'BARP("HIT")
QUIT
+8 SET BARTEST=","_$PIECE($GET(^BARTR(DUZ(2),BARTR,1)),U)_","
+9 IF BARTEST=",,"
QUIT
+10 ;I ",115,116,117,118,"[BARTEST D Q
+11 IF ",49,40,"'[BARTEST
QUIT
+12 ;
+13 ;ERROR
IF $$ISERR(BARTR)
QUIT
+14 ;
SET BARBL=$PIECE($GET(^BARTR(DUZ(2),BARTR,0)),U,4)
+15 ; A/R Transaction 0 node
SET BARTR(0)=$GET(^BARTR(DUZ(2),BARTR,0))
+16 ; A/R Transaction 1 node
SET BARTR(1)=$GET(^BARTR(DUZ(2),BARTR,1))
+17 ; Transaction type
SET BARTR("T")=$PIECE(BARTR(1),U)
+18 ; Transaction date/time
SET BARTR("DT")=$PIECE(BARTR(0),U)
+19 SET BARCR=$PIECE(BARTR(0),"^",2)
+20 SET BARDB=$PIECE(BARTR(0),"^",3)
+21 ;ACCNT
SET BARTRACC=$PIECE(BARTR(0),U,6)
+22 ;PAT FROM BAR 1;1
SET BARPAT=$PIECE(BAR(10),U,1)
+23 SET BARFLG=0
+24 ;BILLED TO PAT
IF BARTRACC]""
IF $GET(^BARAC(DUZ(2),BARTRACC,0))[";AUPNPAT"
IF +$GET(^BARAC(DUZ(2),BARTRACC,0))=BARPAT
SET BARFLG=1
+25 ;BILLED TO other PAT (in err) 1/14/2014
IF BARTRACC]""
IF $GET(^BARAC(DUZ(2),BARTRACC,0))[";AUPNPAT"
IF +$GET(^BARAC(DUZ(2),BARTRACC,0))'=BARPAT
SET BARFLG=-1
+26 ;40 - payment
+27 ;19 - refund
+28 ;20 - payment credit
+29 ;PAYMENT #3.6
SET BARPAY=0
IF BARTR("T")=40
SET BARPAY=$$VAL^XBDIQ1(90050.03,BARTR,3.5)
+30 SET BARADJ=0
+31 ;ADJ #3.7 ;
IF "^3^4^13^14^15^16^"[("^"_BARTR("T")_"^")
SET BARADJ=$$VAL^XBDIQ1(90050.03,BARTR,3.5)
+32 SET BARPAYAD=BARPAY+BARADJ
+33 ;BARFLG=-1 IF PAT WAS CHARGED IN ERR
+34 ;BARFLG=1 IF PAT WAS CHARGED
+35 ;BARFLG=0 IF INS WAS CHARGED
+36 ;1/13/2014
IF BARTR("T")=49
QUIT
+37 SET TMP=BARTR("DT")_"^"_BARTR("T")_"^"_BARCR_"^"_BARDB_"^"_BARPAY_"^"_BARADJ_"^"_BARPAYAD_"^"_BARFLG
+38 ;1ST PART OF BILL #
SET YBARBL=+$PIECE($GET(^BARBL(DUZ(2),BARBL,0)),U,1)
+39 SET ^TMP($JOB,"BAR-NBR9",YBARBL,BARBL,BARTR)=TMP
+40 SET ^TMP($JOB,"BAR-NBR9",YBARBL,BARBL)=$PIECE(BAR(0),U,1)_"^"_$PIECE(BAR(0),U,13)_"^"_$PIECE(BAR(0),U,15)_"^^^"_BARPAT
+41 QUIT
+42 ;---------------------------
MAIN ;^TMP($J,"BAR-NBR9",-->^TMP($J,"BAR-NBRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"),BAR("SUB5")),U,I)
+1 ;
+2 ; BAR("SUB1") = Visit Location
+3 ; BAR("SUB2") = Clinic / visit type
+4 ; BAR("SUB3") = N/A
+5 ; BAR("SUB4") = N/A
+6 ; BAR("SUB5") = A/R Bill
+7 ; OUTPUT DATA - NOT USED
+8 ; BAR(1) = Billed Amount
+9 ; BAR(2) = Insurance Payment
+10 ; BAR(3) = Patient Payment
+11 ; BAR(4) = Balance
+12 ; BAR(5) = Transaction Date
+13 ; -------------------------------
+14 ;
+15 FOR I=1:1:5
SET BAR(I)=0
+16 FOR I=1:1:5
KILL BAR("SUB"_I)
+17 NEW BARX,BAR,BARXTR,BARTR,BARDDD
+18 SET BARY=""
FOR
SET BARY=$ORDER(^TMP($JOB,"BAR-NBR9",BARY))
IF BARY=""
QUIT
Begin DoDot:1
+19 SET BARX="0"
FOR
SET BARX=$ORDER(^TMP($JOB,"BAR-NBR9",BARY,BARX))
IF BARX=""
QUIT
DO ADDUPTR^BARRNBRF(BARY,BARX)
End DoDot:1
+20 SET BARY=""
FOR
SET BARY=$ORDER(^TMP($JOB,"BAR-NBR9",BARY))
IF BARY=""
QUIT
DO ADDUPBL^BARRNBRF(BARY)
+21 SET BARX=""
FOR
SET BARX=$ORDER(^TMP($JOB,"BAR-NBR9",BARX))
IF BARX=""
QUIT
DO MAIN2(BARX)
+22 DO 100^BARRNBRF
+23 DO 110^BARRNBRF
+24 QUIT
+25 ;
MAIN2(YBARBL) ;YBARBL IS THE 1ST PART OF A BILL
+1 NEW PATPAY,INSPAY,BARDATE,BARBL
+2 FOR I=1:1:5
SET BAR(I)=0
+3 SET BARBL=$ORDER(^TMP($JOB,"BAR-NBR9",YBARBL,"0"))
IF BARBL=""
QUIT
+4 SET BARDATE=+^TMP($JOB,"BAR-NBR9",YBARBL,BARBL)
+5 ;GET 'C' AND 'L'
DO EXTRACT(BARBL)
+6 ;Visit Location
SET BAR("SUB1")=$$GET1^DIQ(9999999.06,BARTR("L"),.01)
+7 IF BAR("SUB1")=""
SET BAR("SUB1")="No Visit Location"
+8 IF BARY("SORT")="C"
Begin DoDot:1
+9 ;Clinic / visit type
SET BAR("SUB2")=BAR("C")
+10 IF BAR("SUB2")]""
IF BAR("SUB2")'=99999
SET BAR("SUB2")=$$GET1^DIQ(40.7,BAR("SUB2"),.01)
+11 IF BAR("SUB2")=""!(BAR("SUB2")=99999)
SET BAR("SUB2")="No Clinic Type"
+12 DO STANDARD
End DoDot:1
+13 IF BARY("SORT")="V"
Begin DoDot:1
+14 ;Clinic / visit type
SET BAR("SUB2")=BAR("V")
+15 IF BAR("SUB2")]""
IF BAR("SUB2")'=99999
SET BAR("SUB2")=$$GET1^DIQ(9002274.8,BAR("SUB2"),.01)
+16 IF BAR("SUB2")=""!(BAR("SUB2")=99999)
SET BAR("SUB2")="No Visit Type"
+17 DO STANDARD
End DoDot:1
+18 ;N/A
SET BAR("SUB3")=" "
+19 ;N/A
SET BAR("SUB4")=" "
+20 SET BAR("SUB5")=YBARBL
+21 IF BAR("SUB5")=""
QUIT
+22 DO DETAIL
+23 DO BILL
+24 DO SUMMARY
+25 QUIT
+26 ; *
STANDARD ;
+1 ; Temp global for SORT CRITERIA Clinic or Visit or A/R Account
+2 ; or Discharge Service
+3 ; Detail Lines
+4 NEW I
+5 SET BARHLD=$GET(^TMP($JOB,"BAR-NBR",BAR("SUB1"),BAR("SUB2")))
+6 FOR I=1:1:4
SET $PIECE(^TMP($JOB,"BAR-NBR",BAR("SUB1"),BAR("SUB2")),U,I)=$PIECE(BARHLD,U,I)+BAR(I)
+7 ;
+8 ; Visit Location Totals
+9 SET BARHLD=$GET(^TMP($JOB,"BAR-NBR",BAR("SUB1")))
+10 FOR I=1:1:4
SET $PIECE(^TMP($JOB,"BAR-NBR",BAR("SUB1")),U,I)=$PIECE(BARHLD,U,I)+BAR(I)
+11 ; Report Total
+12 SET BARHLD=$GET(^TMP($JOB,"BAR-NBR"))
+13 FOR I=1:1:4
SET $PIECE(^TMP($JOB,"BAR-NBR"),U,I)=$PIECE(BARHLD,U,I)+BAR(I)
+14 SET ^TMP($JOB,"BAR-NBR",BAR("SUB1"),BAR("SUB2"),YBARBL)=""
+15 QUIT
+16 ; *
+17 ;
SUMMARY ;
+1 ; Temp global for SORT CRITERIA Allowance Category or Billing Entity
+2 ; and Report Type Summarize.
+3 ;
+4 ; Detail Lines
+5 NEW I
+6 SET BARHLD=$GET(^TMP($JOB,"BAR-NBRT",BAR("SUB1"),BAR("SUB3")))
+7 FOR I=1:1:4
SET $PIECE(^TMP($JOB,"BAR-NBRT",BAR("SUB1"),BAR("SUB3")),U,4)=$PIECE(BARHLD,U,I)+BAR(I)
+8 ;
+9 ; Visit Location Totals
+10 SET BARHLD=$GET(^TMP($JOB,"BAR-NBRT",BAR("SUB1")))
+11 FOR I=1:1:4
SET $PIECE(^TMP($JOB,"BAR-NBRT",BAR("SUB1")),U,I)=$PIECE(BARHLD,U,I)+BAR(I)
+12 SET $PIECE(^TMP($JOB,"BAR-NBRT",BAR("SUB1")),U,5)=BARTR("L")
+13 ;
+14 ; Report Total
+15 SET BARHLD=$GET(^TMP($JOB,"BAR-NBRT"))
+16 FOR I=1:1:4
SET $PIECE(^TMP($JOB,"BAR-NBRT"),U,I)=$PIECE(BARHLD,U,I)+BAR(I)
+17 QUIT
+18 ; *
+19 ;
DETAIL ;
+1 ; Temp global for SORT CRITERIA Allowance Category or Billing Entity
+2 ; and Report Type Summarize by payor w/in.
+3 ;
+4 ; Detail Lines
+5 NEW I
+6 SET BARHLD=$GET(^TMP($JOB,"BAR-NBRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4")))
+7 FOR I=1:1:4
SET $PIECE(^TMP($JOB,"BAR-NBRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4")),U,I)=$PIECE(BARHLD,U,I)+BAR(I)
+8 QUIT
+9 ; *
+10 ;
BILL ;
+1 ; Temp global for SORT CRITERIA Allowance Category or Billing Entity
+2 ; and Report Type Summarize by BILL w/in payor w/in.
+3 ;
+4 ; Detail Lines
+5 SET BARHLD=$GET(^TMP($JOB,"BAR-NBRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"),BAR("SUB5")))
+6 FOR I=1:1:4
SET $PIECE(^TMP($JOB,"BAR-NBRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"),BAR("SUB5")),U,I)=$PIECE(BARHLD,U,I)+BAR(I)
+7 SET $PIECE(^TMP($JOB,"BAR-NBRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"),BAR("SUB5")),U,5)=BARDATE
+8 QUIT
+9 ; *
+10 ;
XIT ;
+1 DO ^BARVKL0
+2 QUIT
ISERR(BARTRDT) ;
+1 NEW BARTR,BARTTYP
+2 DO ENP^XBDIQ1(90050.03,BARTRDT,"101;102;103","BARTR(","I")
+3 SET BARTTYP=BARTR(101,"I")
+4 IF BARTTYP'=39
IF BARTTYP'=43
IF BARTTYP'=40
IF BARTTYP'=49
IF BARTTYP'=107
QUIT 0
+5 IF BARTR(103)["ERROR"
QUIT 1
+6 QUIT 0
+1 NEW BAR0,BAR1
+2 ; A/R Bill 0 node
SET BAR0=$GET(^BARBL(DUZ(2),BARBL,0))
+3 ; A/R Bill 1 node
SET BAR1=$GET(^BARBL(DUZ(2),BARBL,1))
+4 ; Visit type (3P Visit Type)
SET BAR("V")=$PIECE(BAR1,U,14)
+5 ; Visit location (A/R Parent/Sat)
SET BARTR("L")=$PIECE(BAR1,U,8)
+6 ; DOS Begin
SET BARTR("D")=$PIECE(BAR1,U,2)
+7 ; Clinic (Clinic Stop File)
SET BARTR("C")=$PIECE(BAR1,U,12)
+8 QUIT
ISNONBEN(BARTR) ;BAR*1.8*24
+1 NEW BAR1,BARPAT,BARTR0,BARBL
+2 SET BARTR0=$GET(^BARTR(DUZ(2),BARTR,0))
+3 SET BARBL=$PIECE(BARTR0,U,4)
IF BARBL=""
QUIT 0
+4 ; A/R Bill 1 node
SET BAR1=$GET(^BARBL(DUZ(2),BARBL,1))
+5 ; Patient (Patient file)
SET BARPAT=$PIECE(BAR1,U,1)
+6 ; <SUBSCRIPT>ISNONBEN+6^BARRNBRA 4/8/14
IF BARPAT=""
QUIT 0
+7 ;Not eligible = > is non-ben
IF $PIECE($GET(^AUPNPAT(BARPAT,11)),U,12)="I"
QUIT 1
+8 QUIT 0
+9 ;------EOR----------
