BARDRST ; IHS/SD/LSL - Statistical Report ; 07/31/2010
;;1.8;IHS ACCOUNTS RECEIVABLE;**19**;OCT 26, 2005
;
; IHS/SD/SDR - V1.6 Patch 1 - Original code by Shonda Render
;
; IHS/SD/LSL - 03/14/2002 - V1.6 Patch 2 - NOIS NDA-0302-180099
; Resolve <UNDEF> DATA+34^BARDRST
;
; IHS/SD/LSL - 04/19/02 - V1.6 Patch 2
; Modified to accomodate new "Location to sort report by" parameter
;
; IHS/SD/LSL - 12/06/02 - V1.7 - NHA-0601-180049
; Look for 3P bill properly.
;
; TMM 07/31/10 - V1.8 Patch 19
; Modify A/R Statistical report to print selected
; (Employer) Group Plans when BILLING ENTITY,
; 6) Selected A/R ACCOUNT is selected. Modify
; report output to allow printing to a device
; or creating a delimited file for import to Excel
; file format
;
; *********************************************************************
; P-1=VISIT CNT, P-2=UNDUP CNT, P-3=$BILLED, P-4=$PAID
; P-5=$ADJUSTMENTS, P-6=$CURRENT BILLED
;
K BAR,BARY
S BARP("RTN")="BARDRST"
S BAR("RTYP")=0,BAR("PAY")=""
S BAR("LOC")=$$GET1^DIQ(90052.06,DUZ(2),16) ; BILLING or VISIT
I BAR("LOC")="" S BAR("LOC")="VISIT"
D ^BARRSEL G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
;
W !
K DIR
S DIR("A",1)="This report will only contain APPROVED bills."
S DIR("A")="Do you wish to include CANCELLED bills"
S DIR("B")="N"
S DIR(0)="Y"
D ^DIR
K DIR
S BAR("STATUS")=Y
;
K DIR,DTOUT,DUOUT,DIROUT,DIRUT
S DIR(0)="SA^P:PRINTED;D:DELIMITED"
S DIR("A")="Should the output be in (P)rinter format or (D)elimited file format? P/D "
K DA
D ^DIR
I $D(DIROUT)!$D(DTOUT)!$D(DUOUT) Q
S BARPRTYP=Y ;selected print type
S BARTEXT=0 ;output = printer format
I Y="D" S BARTEXT=1 ;output = delimited file format
;
S BAR("HD",0)="A/R STATISTICAL REPORT"
D ^BARRHD
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" ;1.8*19 TMM 7/31/10
S BAR("CONJ")="at "
D CHK^BARRHD
;
S BARQ("RC")="COMPUTE^BARDRST"
S BARQ("RX")="POUT^BARRUTL"
S BARQ("NS")="BAR"
S BARQ("RP")="PRINT^BARDRST1"
D ^BARDBQUE
Q
; *********************************************************************
;
COMPUTE ;EP - Entry Point for Setting up Data
K ^TMP($J,"BAR-ST")
K ^TMP($J,"BAR-B")
S BARP("RTN")="BARDRST"
I BAR("LOC")="BILLING" D Q
. S (BAR("NLN"),BAR("NLC"),BAR("NLB"),BAR("NLP"),BAR("NLA"))=0
. D LOOP^BARRUTL
I BAR("LOC")'="BILLING" D Q
. S BARDUZ2=DUZ(2)
. S DUZ(2)=0
. F S DUZ(2)=$O(^BARBL(DUZ(2))) Q:'DUZ(2) D
.. S (BAR("NLN"),BAR("NLC"),BAR("NLB"),BAR("NLP"),BAR("NLA"))=0
.. D LOOP^BARRUTL
. S DUZ(2)=BARDUZ2
Q
; *********************************************************************
;
DATA ;
N BARREC,BARSTAT,BARTYP
S BARREC=^BARBL(DUZ(2),BAR,0) ;MOVE BILL FILE TO BARREC
;SET VISIT TYPE FROM BILL FILE TO BARTYP
S BARTYP=$P($G(^BARBL(DUZ(2),BAR,1)),U,14)
S BARP("HIT")=0
D BILL^BARRCHK Q:'BARP("HIT") ;checks parameters
;
S BAR3P("LOC")=$$FIND3PB^BARUTL(DUZ(2),BAR) ;returns "" or 3PDUZ2^3PBIEN
Q:BAR3P("LOC")=""
S BAR3PDUZ=$P(BAR3P("LOC"),",")
S BAR3PDA=$P(BAR3P("LOC"),",",2)
;
S BARSTAT=$P($G(^ABMDBILL(BAR3PDUZ,BAR3PDA,0)),U,4) ;3PB status
I BAR("STATUS")'=1,(BARSTAT="X") Q ;Quit if cancelled bills not included
;
I BARY("SORT")="C" S BAR("V")=BAR("C") ;C=Clinic V=Visit
S BAR("PT")=$P(^BARBL(DUZ(2),BAR,1),U) ;Patient IEN
S:'$D(BAR("LC",BAR("L"))) BAR("LC",BAR("L"))=0
I '$D(BAR(BAR("L"),BAR("V"))) D
.S BAR(BAR("L"),BAR("V"))="0^0^0^0^0^0"
;
;Next line counts # undup pats
I '$D(^TMP($J,"BAR-ST",BAR("L"),BAR("V"),BAR("PT"))) D
.S ^TMP($J,"BAR-ST",BAR("L"),BAR("V"),BAR("PT"))=""
.S $P(BAR(BAR("L"),BAR("V")),U,2)=$P(BAR(BAR("L"),BAR("V")),U,2)+1
;
;
; NEXT 5 LINES ADDING PAID AMOUNTS
S BARTRAN=0
F S BARTRAN=$O(^BARTR(DUZ(2),"AC",BAR,BARTRAN)) Q:'BARTRAN D
.Q:'$D(^BARTR(DUZ(2),BARTRAN,0)) ; Q if no transaction
.S BAR("PDD")=+^BARTR(DUZ(2),BARTRAN,0)
.I $G(BARY("DT"))="P",BAR("PDD")<BARY("DT",1)!(BAR("PDD")>BARY("DT",2)) Q
.S BARCDT=$P($G(^BARTR(DUZ(2),BARTRAN,0)),U,2)
.S BARDBT=$P($G(^BARTR(DUZ(2),BARTRAN,0)),U,3)
.S BARTTYP=$P($G(^BARTR(DUZ(2),BARTRAN,1)),U)
.Q:BARTTYP=""
.S BARTTYP=$P($G(^BARTBL(BARTTYP,0)),U)
.; only want payment, not payment monthly
.I BARTTYP["PAYMENT",BARTTYP'["MONTHLY" D
..S $P(BAR(BAR("L"),BAR("V")),U,4)=$P(BAR(BAR("L"),BAR("V")),U,4)+BARCDT-BARDBT
.I BARTTYP["ADJUST" D
..S $P(BAR(BAR("L"),BAR("V")),U,5)=$P(BAR(BAR("L"),BAR("V")),U,5)+BARCDT-BARDBT
;
;
; NEXT 3 LINES COUNT TOTAL NUMBER OF UNDUP PATIENTS
I '$D(^TMP($J,"BAR-ST",BAR("L"),BAR("PT"))) D
.S ^TMP($J,"BAR-ST",BAR("L"),BAR("PT"))=""
.S BAR("LC",BAR("L"))=BAR("LC",BAR("L"))+1
;
I '$D(^TMP($J,"BAR-ST",BAR("PT"))) D
.S ^TMP($J,"BAR-ST",BAR("PT"))=""
.S BAR("NLC")=BAR("NLC")+1
;
; NEXT 3 LINES CHECKS FOR FIRST VALID BILL
S BARBILL=BARREC
Q:$D(^TMP($J,"BAR-B",BARBILL)) ;CK IF IS FOUND
S ^TMP($J,"BAR-B",BARBILL)="" ;CK IF TMP IS UNIQUE USING BAR-B
;
; NEXT LINE COUNTS # OF VISITS
S $P(BAR(BAR("L"),BAR("V")),U)=$P(BAR(BAR("L"),BAR("V")),U)+1
;
;Next line is adding billed amount
S $P(BAR(BAR("L"),BAR("V")),U,3)=$P(BAR(BAR("L"),BAR("V")),U,3)+$P(^BARBL(DUZ(2),BAR,0),U,13)
I BARTYP=111 D ;CK IF NOT EQUAL TO OUTPATIENT-NEED ONLY INPATIENTS
.S BAR(BAR("L"),"COVD")=$G(BAR(BAR("L"),"COVD"))+$P($G(^ABMDBILL(BAR3PDUZ,BAR3PDA,7)),U,3)
S $P(BAR(BAR("L"),BAR("V")),U,6)=$P(BAR(BAR("L"),BAR("V")),U,6)+$P($G(^BARBL(DUZ(2),BAR,0)),U,15)
;
Q
; *********************************************************************
;
XIT K BAR,BARY,BARP
Q
;
TEXTCK() ; Text delimited file <--NEW TAG(TEXTCK) ;1.8*19 TMM 7/31/10
N BARTXT
S BARTXT=""
I $G(BARTEXT)=1 S BARTXT="^"
Q BARTXT
BARDRST ; IHS/SD/LSL - Statistical Report ; 07/31/2010
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**19**;OCT 26, 2005
+2 ;
+3 ; IHS/SD/SDR - V1.6 Patch 1 - Original code by Shonda Render
+4 ;
+5 ; IHS/SD/LSL - 03/14/2002 - V1.6 Patch 2 - NOIS NDA-0302-180099
+6 ; Resolve <UNDEF> DATA+34^BARDRST
+7 ;
+8 ; IHS/SD/LSL - 04/19/02 - V1.6 Patch 2
+9 ; Modified to accomodate new "Location to sort report by" parameter
+10 ;
+11 ; IHS/SD/LSL - 12/06/02 - V1.7 - NHA-0601-180049
+12 ; Look for 3P bill properly.
+13 ;
+14 ; TMM 07/31/10 - V1.8 Patch 19
+15 ; Modify A/R Statistical report to print selected
+16 ; (Employer) Group Plans when BILLING ENTITY,
+17 ; 6) Selected A/R ACCOUNT is selected. Modify
+18 ; report output to allow printing to a device
+19 ; or creating a delimited file for import to Excel
+20 ; file format
+21 ;
+22 ; *********************************************************************
+23 ; P-1=VISIT CNT, P-2=UNDUP CNT, P-3=$BILLED, P-4=$PAID
+24 ; P-5=$ADJUSTMENTS, P-6=$CURRENT BILLED
+25 ;
+26 KILL BAR,BARY
+27 SET BARP("RTN")="BARDRST"
+28 SET BAR("RTYP")=0
SET BAR("PAY")=""
+29 ; BILLING or VISIT
SET BAR("LOC")=$$GET1^DIQ(90052.06,DUZ(2),16)
+30 IF BAR("LOC")=""
SET BAR("LOC")="VISIT"
+31 DO ^BARRSEL
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO XIT
+32 ;
+33 WRITE !
+34 KILL DIR
+35 SET DIR("A",1)="This report will only contain APPROVED bills."
+36 SET DIR("A")="Do you wish to include CANCELLED bills"
+37 SET DIR("B")="N"
+38 SET DIR(0)="Y"
+39 DO ^DIR
+40 KILL DIR
+41 SET BAR("STATUS")=Y
+42 ;
+43 KILL DIR,DTOUT,DUOUT,DIROUT,DIRUT
+44 SET DIR(0)="SA^P:PRINTED;D:DELIMITED"
+45 SET DIR("A")="Should the output be in (P)rinter format or (D)elimited file format? P/D "
+46 KILL DA
+47 DO ^DIR
+48 IF $DATA(DIROUT)!$DATA(DTOUT)!$DATA(DUOUT)
QUIT
+49 ;selected print type
SET BARPRTYP=Y
+50 ;output = printer format
SET BARTEXT=0
+51 ;output = delimited file format
IF Y="D"
SET BARTEXT=1
+52 ;
+53 SET BAR("HD",0)="A/R STATISTICAL REPORT"
+54 DO ^BARRHD
+55 SET BAR("TXT")="ALL"
+56 IF $DATA(BARY("LOC"))
SET BAR("TXT")=$PIECE(^DIC(4,BARY("LOC"),0),U)
+57 IF BAR("LOC")="BILLING"
Begin DoDot:1
+58 SET BAR("TXT")=BAR("TXT")_" Visit location(s) under "
+59 SET BAR("TXT")=BAR("TXT")_$PIECE(^DIC(4,DUZ(2),0),U)
+60 SET BAR("TXT")=BAR("TXT")_" Billing Location"
End DoDot:1
+61 ;1.8*19 TMM 7/31/10
IF '$TEST
SET BAR("TXT")=BAR("TXT")_" Visit location(s) regardless of Billing Location"
+62 SET BAR("CONJ")="at "
+63 DO CHK^BARRHD
+64 ;
+65 SET BARQ("RC")="COMPUTE^BARDRST"
+66 SET BARQ("RX")="POUT^BARRUTL"
+67 SET BARQ("NS")="BAR"
+68 SET BARQ("RP")="PRINT^BARDRST1"
+69 DO ^BARDBQUE
+70 QUIT
+71 ; *********************************************************************
+72 ;
COMPUTE ;EP - Entry Point for Setting up Data
+1 KILL ^TMP($JOB,"BAR-ST")
+2 KILL ^TMP($JOB,"BAR-B")
+3 SET BARP("RTN")="BARDRST"
+4 IF BAR("LOC")="BILLING"
Begin DoDot:1
+5 SET (BAR("NLN"),BAR("NLC"),BAR("NLB"),BAR("NLP"),BAR("NLA"))=0
+6 DO LOOP^BARRUTL
End DoDot:1
QUIT
+7 IF BAR("LOC")'="BILLING"
Begin DoDot:1
+8 SET BARDUZ2=DUZ(2)
+9 SET DUZ(2)=0
+10 FOR
SET DUZ(2)=$ORDER(^BARBL(DUZ(2)))
IF 'DUZ(2)
QUIT
Begin DoDot:2
+11 SET (BAR("NLN"),BAR("NLC"),BAR("NLB"),BAR("NLP"),BAR("NLA"))=0
+12 DO LOOP^BARRUTL
End DoDot:2
+13 SET DUZ(2)=BARDUZ2
End DoDot:1
QUIT
+14 QUIT
+15 ; *********************************************************************
+16 ;
DATA ;
+1 NEW BARREC,BARSTAT,BARTYP
+2 ;MOVE BILL FILE TO BARREC
SET BARREC=^BARBL(DUZ(2),BAR,0)
+3 ;SET VISIT TYPE FROM BILL FILE TO BARTYP
+4 SET BARTYP=$PIECE($GET(^BARBL(DUZ(2),BAR,1)),U,14)
+5 SET BARP("HIT")=0
+6 ;checks parameters
DO BILL^BARRCHK
IF 'BARP("HIT")
QUIT
+7 ;
+8 ;returns "" or 3PDUZ2^3PBIEN
SET BAR3P("LOC")=$$FIND3PB^BARUTL(DUZ(2),BAR)
+9 IF BAR3P("LOC")=""
QUIT
+10 SET BAR3PDUZ=$PIECE(BAR3P("LOC"),",")
+11 SET BAR3PDA=$PIECE(BAR3P("LOC"),",",2)
+12 ;
+13 ;3PB status
SET BARSTAT=$PIECE($GET(^ABMDBILL(BAR3PDUZ,BAR3PDA,0)),U,4)
+14 ;Quit if cancelled bills not included
IF BAR("STATUS")'=1
IF (BARSTAT="X")
QUIT
+15 ;
+16 ;C=Clinic V=Visit
IF BARY("SORT")="C"
SET BAR("V")=BAR("C")
+17 ;Patient IEN
SET BAR("PT")=$PIECE(^BARBL(DUZ(2),BAR,1),U)
+18 IF '$DATA(BAR("LC",BAR("L")))
SET BAR("LC",BAR("L"))=0
+19 IF '$DATA(BAR(BAR("L"),BAR("V")))
Begin DoDot:1
+20 SET BAR(BAR("L"),BAR("V"))="0^0^0^0^0^0"
End DoDot:1
+21 ;
+22 ;Next line counts # undup pats
+23 IF '$DATA(^TMP($JOB,"BAR-ST",BAR("L"),BAR("V"),BAR("PT")))
Begin DoDot:1
+24 SET ^TMP($JOB,"BAR-ST",BAR("L"),BAR("V"),BAR("PT"))=""
+25 SET $PIECE(BAR(BAR("L"),BAR("V")),U,2)=$PIECE(BAR(BAR("L"),BAR("V")),U,2)+1
End DoDot:1
+26 ;
+27 ;
+28 ; NEXT 5 LINES ADDING PAID AMOUNTS
+29 SET BARTRAN=0
+30 FOR
SET BARTRAN=$ORDER(^BARTR(DUZ(2),"AC",BAR,BARTRAN))
IF 'BARTRAN
QUIT
Begin DoDot:1
+31 ; Q if no transaction
IF '$DATA(^BARTR(DUZ(2),BARTRAN,0))
QUIT
+32 SET BAR("PDD")=+^BARTR(DUZ(2),BARTRAN,0)
+33 IF $GET(BARY("DT"))="P"
IF BAR("PDD")<BARY("DT",1)!(BAR("PDD")>BARY("DT",2))
QUIT
+34 SET BARCDT=$PIECE($GET(^BARTR(DUZ(2),BARTRAN,0)),U,2)
+35 SET BARDBT=$PIECE($GET(^BARTR(DUZ(2),BARTRAN,0)),U,3)
+36 SET BARTTYP=$PIECE($GET(^BARTR(DUZ(2),BARTRAN,1)),U)
+37 IF BARTTYP=""
QUIT
+38 SET BARTTYP=$PIECE($GET(^BARTBL(BARTTYP,0)),U)
+39 ; only want payment, not payment monthly
+40 IF BARTTYP["PAYMENT"
IF BARTTYP'["MONTHLY"
Begin DoDot:2
+41 SET $PIECE(BAR(BAR("L"),BAR("V")),U,4)=$PIECE(BAR(BAR("L"),BAR("V")),U,4)+BARCDT-BARDBT
End DoDot:2
+42 IF BARTTYP["ADJUST"
Begin DoDot:2
+43 SET $PIECE(BAR(BAR("L"),BAR("V")),U,5)=$PIECE(BAR(BAR("L"),BAR("V")),U,5)+BARCDT-BARDBT
End DoDot:2
End DoDot:1
+44 ;
+45 ;
+46 ; NEXT 3 LINES COUNT TOTAL NUMBER OF UNDUP PATIENTS
+47 IF '$DATA(^TMP($JOB,"BAR-ST",BAR("L"),BAR("PT")))
Begin DoDot:1
+48 SET ^TMP($JOB,"BAR-ST",BAR("L"),BAR("PT"))=""
+49 SET BAR("LC",BAR("L"))=BAR("LC",BAR("L"))+1
End DoDot:1
+50 ;
+51 IF '$DATA(^TMP($JOB,"BAR-ST",BAR("PT")))
Begin DoDot:1
+52 SET ^TMP($JOB,"BAR-ST",BAR("PT"))=""
+53 SET BAR("NLC")=BAR("NLC")+1
End DoDot:1
+54 ;
+55 ; NEXT 3 LINES CHECKS FOR FIRST VALID BILL
+56 SET BARBILL=BARREC
+57 ;CK IF IS FOUND
IF $DATA(^TMP($JOB,"BAR-B",BARBILL))
QUIT
+58 ;CK IF TMP IS UNIQUE USING BAR-B
SET ^TMP($JOB,"BAR-B",BARBILL)=""
+59 ;
+60 ; NEXT LINE COUNTS # OF VISITS
+61 SET $PIECE(BAR(BAR("L"),BAR("V")),U)=$PIECE(BAR(BAR("L"),BAR("V")),U)+1
+62 ;
+63 ;Next line is adding billed amount
+64 SET $PIECE(BAR(BAR("L"),BAR("V")),U,3)=$PIECE(BAR(BAR("L"),BAR("V")),U,3)+$PIECE(^BARBL(DUZ(2),BAR,0),U,13)
+65 ;CK IF NOT EQUAL TO OUTPATIENT-NEED ONLY INPATIENTS
IF BARTYP=111
Begin DoDot:1
+66 SET BAR(BAR("L"),"COVD")=$GET(BAR(BAR("L"),"COVD"))+$PIECE($GET(^ABMDBILL(BAR3PDUZ,BAR3PDA,7)),U,3)
End DoDot:1
+67 SET $PIECE(BAR(BAR("L"),BAR("V")),U,6)=$PIECE(BAR(BAR("L"),BAR("V")),U,6)+$PIECE($GET(^BARBL(DUZ(2),BAR,0)),U,15)
+68 ;
+69 QUIT
+70 ; *********************************************************************
+71 ;
XIT KILL BAR,BARY,BARP
+1 QUIT
+2 ;
TEXTCK() ; Text delimited file <--NEW TAG(TEXTCK) ;1.8*19 TMM 7/31/10
+1 NEW BARTXT
+2 SET BARTXT=""
+3 IF $GET(BARTEXT)=1
SET BARTXT="^"
+4 QUIT BARTXT
