BARDRST1 ; IHS/SD/LSL - Statistical Report - Part 3 ; 07/30/2010
;;1.8;IHS ACCOUNTS RECEIVABLE;**10,15,19,20**;OCT 26, 2005
;
; TMM 11/13/09 1.8*15 Resolve HEAT 8548. Error in BARDRST1.
; TMM 07/30/2010 1.8*19 Modify A/R Statistical Report to print
; in a printer or delimited file format.
; Allow user to select (Employer) Group Plans
; when selecting by BILLING ENTITY/6)SELECT
; A SPECIFIC A/R ACCOUNT. See requirement
; 4PMS10022.
; ********************************************************************
PRINT ;EP for writing data
S BAR("PG")=0
;K BAR(1) bar*1.8*20 HEAT27283
;start new code bar*1.8*20 HEAT27283
I $D(BAR(1))<11 K BAR(1)
I $D(BAR(1))>10 D
.S BAR("L")=0
.K BARTMP
.F S BAR("L")=$O(BAR(1,BAR("L"))) Q:'BAR("L") M BARTMP(1,BAR("L"))=BAR(1,BAR("L"))
.M BAR(1,"COVD")=BAR(1,"COVD")
.K BAR(1)
.M BAR(1)=BARTMP(1)
.K BARTMP
;end new code HEAT27283
K BAR(0)
D HDB
S BAR("L")=0
S BAR("NLU")=0 ;MRS:BAR*1.8*10 H2260
F BAR("NL")=1:1 S BAR("L")=$O(BAR(BAR("L"))) Q:'BAR("L") D G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
.I $Y>(IOSL-7) D HD Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
.W !!,$P(^DIC(4,BAR("L"),0),U)
.S (BAR("N"),BAR("B"),BAR("P"),BAR("A"),BAR("C"))=0
.S UNDUP=0 ;M1*TMM*11/13/2009 HEAT_8548
.S BAR("V")=""
.F S BAR("V")=$O(BAR(BAR("L"),BAR("V"))) Q:'BAR("V") D G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
..I $Y>(IOSL-6) D HD Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) W !,$P(^DIC(4,BAR("L"),0),U)," (cont)"
..; ---BEGIN DEL(1)---> ;M819*ADD*TMM*20100801-->replaced with ADD(1) section that follows
..; Replace current WRITE's with WRITE/DELIMITER dependent on BARTEXT value
..; ;Nest line prints visit type ;M819*DEL*TMM*20100801
..; ..W !?2 ;M819*DEL*TMM*20100731
..; ..I BARY("SORT")="V" D ;M819*DEL*TMM*20100801
..; ...I BAR("V")=99999 W "NO VISIT TYP" Q ;M819*DEL*TMM*20100801
..; ...I $P($G(^ABMDVTYP(BAR("V"),0)),U)]"" W $E($P(^ABMDVTYP(BAR("V"),0),U),1,12) Q ;M819*DEL*TMM*20100801
..; ...W "DELETED ",BAR("V") ;M819*DEL*TMM*20100801
..; ..E D ;M819*DEL*TMM*20100801
..; ...I BAR("V")=99999 W "NO CLINIC" Q ;M819*DEL*TMM*20100801
..; ...W $E($P(^DIC(40.7,BAR("V"),0),U),1,12) ;clinic stop name ;M819*DEL*TMM*20100801
..; ..W ?16,$J($FN($P(BAR(BAR("L"),BAR("V")),U),",",0),5) ;number of visits ;M819*DEL*TMM*20100801
..; ..W ?22,$J($FN($P(BAR(BAR("L"),BAR("V")),U,2),",",0),5) ;total undup patients ;M819*DEL*TMM*20100801
..; ..S UNDUP=UNDUP+$P(BAR(BAR("L"),BAR("V")),U,2) ;M1*TMM*11/13/2009 HEAT_8548 ;M819*DEL*TMM*20100801
..; ..;Next line writes $ with comma and cents ;M819*DEL*TMM*20100801
..; ..W ?27,$J($FN($P(BAR(BAR("L"),BAR("V")),U,3),",",2),13) ;total billed amount ;M819*DEL*TMM*20100801
..; ..W ?41,$J($FN($P(BAR(BAR("L"),BAR("V")),U,4),",",2),12) ;total paid amount ;M819*DEL*TMM*20100801
..; ..W ?55,$J($FN($P(BAR(BAR("L"),BAR("V")),U,5),",",2),12) ;total adjustment amount ;M819*DEL*TMM*20100801
..; ..W ?66,$J($FN($P(BAR(BAR("L"),BAR("V")),U,6),",",2),13) ;total unpaid amount ;M819*DEL*TMM*20100801
..; -----END DEL(1)---> ;M819*ADD*TMM*20100801-->replaced with ADD(1) section that follows
..; ---BEGIN ADD(1)---> ;M819*ADD*TMM*20100801-->replaces DEL(1) section preceding this section
..; Next line prints visit type
..I $G(BARTEXT)'=1 W !?2
..I $G(BARTEXT)=1 W !,"^"
..I BARY("SORT")="V" D
...I BAR("V")=99999 W "NO VISIT TYP"_$$TEXTCK^BARDRST() Q ;(B)
...I $P($G(^ABMDVTYP(BAR("V"),0)),U)]"" W $E($P(^ABMDVTYP(BAR("V"),0),U),1,12)_$$TEXTCK^BARDRST() Q ;(B)
...W "DELETED ",BAR("V")_$$TEXTCK^BARDRST() ;(B)
..E D
...I BAR("V")=99999 W "NO CLINIC"_$$TEXTCK^BARDRST() Q ;(B)
...W $E($P(^DIC(40.7,BAR("V"),0),U),1,12)_$$TEXTCK^BARDRST() ;clinic stop name (B)
..I $E(BARTEXT)'=1 D
...W ?16,$J($FN($P(BAR(BAR("L"),BAR("V")),U),",",0),5) ;number of visits
...W ?22,$J($FN($P(BAR(BAR("L"),BAR("V")),U,2),",",0),5) ;total undup patients
..I $E(BARTEXT)=1 D
...W $J($FN($P(BAR(BAR("L"),BAR("V")),U),",",0),5)_"^" ;number of visits (C)
...W $J($FN($P(BAR(BAR("L"),BAR("V")),U,2),",",0),5)_"^" ;total undup patients (D)
..S UNDUP=UNDUP+$P(BAR(BAR("L"),BAR("V")),U,2) ;M1*TMM*11/13/2009 HEAT_8548
..; Next line writes $ with comma and cents
..I $E(BARTEXT)'=1 D
...W ?27,$J($FN($P(BAR(BAR("L"),BAR("V")),U,3),",",2),13) ;total billed amount
...W ?41,$J($FN($P(BAR(BAR("L"),BAR("V")),U,4),",",2),12) ;total paid amount
...W ?55,$J($FN($P(BAR(BAR("L"),BAR("V")),U,5),",",2),12) ;total adjustment amount
...W ?66,$J($FN($P(BAR(BAR("L"),BAR("V")),U,6),",",2),13) ;total unpaid amount
..I $E(BARTEXT)=1 D
...W $J($FN($P(BAR(BAR("L"),BAR("V")),U,3),",",2),13)_"^" ;total billed amount (E)
...W $J($FN($P(BAR(BAR("L"),BAR("V")),U,4),",",2),12)_"^" ;total paid amount (F)
...W $J($FN($P(BAR(BAR("L"),BAR("V")),U,5),",",2),12)_"^" ;total adjustment amount (G)
...W $J($FN($P(BAR(BAR("L"),BAR("V")),U,6),",",2),13)_"^" ;total unpaid amount (H)
..; -----END ADD(1)---> ;M819*ADD*TMM*20100801-->replaces DEL section preceding this section
..S BAR("N")=$P(BAR(BAR("L"),BAR("V")),U,1)+BAR("N")
..S BAR("NLN")=BAR("NLN")+$P(BAR(BAR("L"),BAR("V")),U,1)
..S BAR("B")=$P(BAR(BAR("L"),BAR("V")),U,3)+BAR("B")
..S BAR("NLB")=BAR("NLB")+$P(BAR(BAR("L"),BAR("V")),U,3)
..S BAR("P")=$P(BAR(BAR("L"),BAR("V")),U,4)+BAR("P")
..S BAR("NLP")=BAR("NLP")+$P(BAR(BAR("L"),BAR("V")),U,4)
..S BAR("A")=$P(BAR(BAR("L"),BAR("V")),U,5)+BAR("A")
..S BAR("NLA")=BAR("NLA")+$P(BAR(BAR("L"),BAR("V")),U,5)
..S BAR("C")=$P(BAR(BAR("L"),BAR("V")),U,6)+BAR("C")
..;S BAR("NLC")=BAR("NLC")+$P(BAR(BAR("L"),BAR("V")),U,6) ;MRS:BAR*1.8*10 H2260
..S BAR("NLU")=BAR("NLU")+$P(BAR(BAR("L"),BAR("V")),U,6) ;MRS:BAR*1.8*10 H2260
.;---BEGIN DEL(2)---> ;M819*ADD*TMM*20100801-->replaced with ADD(2) section that follows
.; .W !,?15,"------",?22,"------",?30,"----------",?43,"----------",?57,"----------",?70,"----------"
.; .W !?16,$J($FN(BAR("N"),",",0),5)
.; .;W ?22,$J($FN(BAR("LC",BAR("L")),",",0),5) ;M1*TMM*11/13/2009 HEAT_8548
.; .W ?22,$J($FN(UNDUP,",",0),5) ;M1*TMM*11/13/2009 HEAT_8548
.; .W ?28,$J($FN(BAR("B"),",",2),12)
.; .W ?40,$J($FN(BAR("P"),",",2),13)
.; .W ?55,$J($FN(BAR("A"),",",2),12)
.; .W ?67,$J($FN(BAR("C"),",",2),13)
.; .;PRINT INPATIENT DAYS - WILL PRINT 0 DAYS ALSO
.; .W !!
.; .W "TOTAL COVERED INPATIENT DAYS ",+$GET(BAR(BAR("L"),"COVD"))
.; .W !
.; W !,?10,"END OF REPORT",!
.; -----END DEL(2)---> ;M819*ADD*TMM*20100801-->replaced with ADD(2) section that follows
.; ---BEGIN ADD(2)---> ;M819*ADD*TMM*20100801-->replaces DEL(2) section preceding this section
.; Printer format
.I $G(BARTEXT)'=1 D
..W !,?15,"------",?22,"------",?30,"----------",?43,"----------",?57,"----------",?70,"----------"
..W !?16,$J($FN(BAR("N"),",",0),5)
..;W ?22,$J($FN(BAR("LC",BAR("L")),",",0),5) ;M1*TMM*11/13/2009 HEAT_8548
..W ?22,$J($FN(UNDUP,",",0),5) ;M1*TMM*11/13/2009 HEAT_8548
..W ?28,$J($FN(BAR("B"),",",2),12)
..W ?40,$J($FN(BAR("P"),",",2),13)
..W ?55,$J($FN(BAR("A"),",",2),12)
..W ?67,$J($FN(BAR("C"),",",2),13)
.; Delimited file format
.I $G(BARTEXT)=1 D
..W !,"^^------^------^----------^----------^----------^----------"
..W !,"^^",$J($FN(BAR("N"),",",0),5) ;(C)
..;W "^^",$J($FN(BAR("LC",BAR("L")),",",0),5) ;M1*TMM*11/13/2009 HEAT_8548
..W "^",$J($FN(UNDUP,",",0),5) ;(D) M1*TMM*11/13/2009 HEAT_8548
..W "^",$J($FN(BAR("B"),",",2),12) ;(E)
..W "^",$J($FN(BAR("P"),",",2),13) ;(F)
..W "^",$J($FN(BAR("A"),",",2),12) ;(G)
..W "^",$J($FN(BAR("C"),",",2),13) ;(H)
..;PRINT INPATIENT DAYS - WILL PRINT 0 DAYS ALSO
.W !!
.I $G(BARTEXT)'=1 W "TOTAL COVERED INPATIENT DAYS ",+$GET(BAR(BAR("L"),"COVD"))
.I $G(BARTEXT)=1 W "^TOTAL COVERED INPATIENT DAYS^",+$GET(BAR(BAR("L"),"COVD"))
.W !
.W !,"END OF REPORT",!
.; -----END ADD(2)---> ;M819*ADD*TMM*20100801-->replaces DEL(2) section preceding this section
;
I $E(IOST)="C",'$D(IO("S")) D
.K DIR
.S DIR(0)="E"
.D ^DIR
.K DIR
I BAR("NL")<3 G XIT
; ---BEGIN DEL(3)---> ;M819*DEL*TMM*20100801 replaced with ADD(3) section that follows
W !,?17,"======",?25,"======",?29,"==========",?42,"==========",?67,"=========="
;TOOK OUT TOTAL UNDUP CNT 2/98 SL
W !?10,"Total:",?20,$J($FN(BAR("NLN"),",",0),5)
W ?29,$J($FN(BAR("NLB"),",",2),13)
W ?41,$J($FN(BAR("NLP"),",",2),13)
W ?55,$J($FN(BAR("NLA"),",",2),12)
;W ?67,$J($FN(BAR("NLC"),",",2),13) ;MRS:BAR*1.8*10 H2260
W ?67,$J($FN(BAR("NLU"),",",2),13) ;MRS:BAR*1.8*10 H2260
; -----END DEL(3)---> ;M819*DEL*TMM*20100801 replaced with ADD(3) section that follows
; ---BEGIN DEL(3)---> ;M819*DEL*TMM*20100801 replaced with ADD(3) section that follows
; Printer format
I $G(BARTEXT)'=1 D
. W !,?17,"======",?25,"======",?29,"==========",?42,"==========",?67,"=========="
. ;TOOK OUT TOTAL UNDUP CNT 2/98 SL
. W !?10,"Total:",?20,$J($FN(BAR("NLN"),",",0),5)
. W ?29,$J($FN(BAR("NLB"),",",2),13)
. W ?41,$J($FN(BAR("NLP"),",",2),13)
. W ?55,$J($FN(BAR("NLA"),",",2),12)
. ;W ?67,$J($FN(BAR("NLC"),",",2),13) ;MRS:BAR*1.8*10 H2260
. W ?67,$J($FN(BAR("NLU"),",",2),13) ;MRS:BAR*1.8*10 H2260
; Delimited file format
I $G(BARTEXT)=1 D
. W !,"^======^======^==========^==========^=========="
. ;TOOK OUT TOTAL UNDUP CNT 2/98 SL
. W !,"^^Total:^",$J($FN(BAR("NLN"),",",0),5)
. W "^",$J($FN(BAR("NLB"),",",2),13)
. W "^",$J($FN(BAR("NLP"),",",2),13)
. W "^",$J($FN(BAR("NLA"),",",2),12)
. ;W ?67,$J($FN(BAR("NLC"),",",2),13) ;MRS:BAR*1.8*10 H2260
. W "^",$J($FN(BAR("NLU"),",",2),13) ;MRS:BAR*1.8*10 H2260
; -----END DEL(3)---> ;M819*DEL*TMM*20100801 replaced with ADD(3) section that follows
G XIT
; *********************************************************************
HD ;
D PAZ^BARRUTL
Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
;
HDB ;
S BAR("PG")=BAR("PG")+1
S BAR("I")=""
D WHD^BARRHD
; ---BEGIN DEL(1)---> ;M819*ADD*TMM*20100731--> replaced by ADD(1) section that follows
;W !!?2,$S(BARY("SORT")="V":"VISIT",1:"") ;M819*DEL*TMM*20100731
;W ?15,"NUMBER",?22,"UNDUP",?35,"BILLED",?48,"PAID",?60,"ADJ",?74,"UNPAID" ;M819*DEL*TMM*20100731
;W !?2,$S(BARY("SORT")="V":"TYPE",1:"CLINIC") ;M819*DEL*TMM*20100731
;W ?15,"VISITS",?22,"PATIENTS",?35,"AMOUNT",?48,"AMOUNT",?60,"AMOUNT",?74,"AMOUNT" ;M819*DEL*TMM*20100731
;W !,"-------------------------------------------------------------------------------" ;M819*DEL*TMM*20100731
; -----END DEL(1)---> ;M819*ADD*TMM*20100731--> replaced by ADD(1) section that follows
; ---BEGIN ADD(1)---> ;M819*ADD*TMM*20100731--> replaces DEL(1) section that preceds this
I $G(BARTEXT)'=1 D
.W !!?2,$S(BARY("SORT")="V":"VISIT",1:"") ;M819*DEL*TMM*20100731
.W ?15,"NUMBER",?22,"UNDUP",?35,"BILLED",?48,"PAID",?60,"ADJ",?74,"UNPAID"
.W !?2,$S(BARY("SORT")="V":"TYPE",1:"CLINIC") ;M819*DEL*TMM*20100731
.W ?15,"VISITS",?22,"PATIENTS",?35,"AMOUNT",?48,"AMOUNT",?60,"AMOUNT",?74,"AMOUNT"
.S $P(BARTMPLN,"-",80)=""
.W !,BARTMPLN
I $G(BARTEXT)=1 D
.W !!,U,$S(BARY("SORT")="V":"VISIT",1:"")
.W U,"NUMBER",U,"UNDUP",U,"BILLED",U,"PAID",U,"ADJ",U,"UNPAID"
.W !,U,$S(BARY("SORT")="V":"TYPE",1:"CLINIC")
.W U,"VISITS",U,"PATIENTS",U,"AMOUNT",U,"AMOUNT",U,"AMOUNT",U,"AMOUNT"
.S $P(BARTMPLN,"-",80)=""
.W !,"^",BARTMPLN
; -----END ADD(1)---> ;M819*ADD*TMM*20100731--> replaces DEL(1) section that preceds thisQ
; *********************************************************************
XIT ;
K ^TMP($J,"BAR-ST")
Q
BARDRST1 ; IHS/SD/LSL - Statistical Report - Part 3 ; 07/30/2010
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**10,15,19,20**;OCT 26, 2005
+2 ;
+3 ; TMM 11/13/09 1.8*15 Resolve HEAT 8548. Error in BARDRST1.
+4 ; TMM 07/30/2010 1.8*19 Modify A/R Statistical Report to print
+5 ; in a printer or delimited file format.
+6 ; Allow user to select (Employer) Group Plans
+7 ; when selecting by BILLING ENTITY/6)SELECT
+8 ; A SPECIFIC A/R ACCOUNT. See requirement
+9 ; 4PMS10022.
+10 ; ********************************************************************
PRINT ;EP for writing data
+1 SET BAR("PG")=0
+2 ;K BAR(1) bar*1.8*20 HEAT27283
+3 ;start new code bar*1.8*20 HEAT27283
+4 IF $DATA(BAR(1))<11
KILL BAR(1)
+5 IF $DATA(BAR(1))>10
Begin DoDot:1
+6 SET BAR("L")=0
+7 KILL BARTMP
+8 FOR
SET BAR("L")=$ORDER(BAR(1,BAR("L")))
IF 'BAR("L")
QUIT
MERGE BARTMP(1,BAR("L"))=BAR(1,BAR("L"))
+9 MERGE BAR(1,"COVD")=BAR(1,"COVD")
+10 KILL BAR(1)
+11 MERGE BAR(1)=BARTMP(1)
+12 KILL BARTMP
End DoDot:1
+13 ;end new code HEAT27283
+14 KILL BAR(0)
+15 DO HDB
+16 SET BAR("L")=0
+17 ;MRS:BAR*1.8*10 H2260
SET BAR("NLU")=0
+18 FOR BAR("NL")=1:1
SET BAR("L")=$ORDER(BAR(BAR("L")))
IF 'BAR("L")
QUIT
Begin DoDot:1
+19 IF $Y>(IOSL-7)
DO HD
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+20 WRITE !!,$PIECE(^DIC(4,BAR("L"),0),U)
+21 SET (BAR("N"),BAR("B"),BAR("P"),BAR("A"),BAR("C"))=0
+22 ;M1*TMM*11/13/2009 HEAT_8548
SET UNDUP=0
+23 SET BAR("V")=""
+24 FOR
SET BAR("V")=$ORDER(BAR(BAR("L"),BAR("V")))
IF 'BAR("V")
QUIT
Begin DoDot:2
+25 IF $Y>(IOSL-6)
DO HD
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
WRITE !,$PIECE(^DIC(4,BAR("L"),0),U)," (cont)"
+26 ; ---BEGIN DEL(1)---> ;M819*ADD*TMM*20100801-->replaced with ADD(1) section that follows
+27 ; Replace current WRITE's with WRITE/DELIMITER dependent on BARTEXT value
+28 ; ;Nest line prints visit type ;M819*DEL*TMM*20100801
+29 ; ..W !?2 ;M819*DEL*TMM*20100731
+30 ; ..I BARY("SORT")="V" D ;M819*DEL*TMM*20100801
+31 ; ...I BAR("V")=99999 W "NO VISIT TYP" Q ;M819*DEL*TMM*20100801
+32 ; ...I $P($G(^ABMDVTYP(BAR("V"),0)),U)]"" W $E($P(^ABMDVTYP(BAR("V"),0),U),1,12) Q ;M819*DEL*TMM*20100801
+33 ; ...W "DELETED ",BAR("V") ;M819*DEL*TMM*20100801
+34 ; ..E D ;M819*DEL*TMM*20100801
+35 ; ...I BAR("V")=99999 W "NO CLINIC" Q ;M819*DEL*TMM*20100801
+36 ; ...W $E($P(^DIC(40.7,BAR("V"),0),U),1,12) ;clinic stop name ;M819*DEL*TMM*20100801
+37 ; ..W ?16,$J($FN($P(BAR(BAR("L"),BAR("V")),U),",",0),5) ;number of visits ;M819*DEL*TMM*20100801
+38 ; ..W ?22,$J($FN($P(BAR(BAR("L"),BAR("V")),U,2),",",0),5) ;total undup patients ;M819*DEL*TMM*20100801
+39 ; ..S UNDUP=UNDUP+$P(BAR(BAR("L"),BAR("V")),U,2) ;M1*TMM*11/13/2009 HEAT_8548 ;M819*DEL*TMM*20100801
+40 ; ..;Next line writes $ with comma and cents ;M819*DEL*TMM*20100801
+41 ; ..W ?27,$J($FN($P(BAR(BAR("L"),BAR("V")),U,3),",",2),13) ;total billed amount ;M819*DEL*TMM*20100801
+42 ; ..W ?41,$J($FN($P(BAR(BAR("L"),BAR("V")),U,4),",",2),12) ;total paid amount ;M819*DEL*TMM*20100801
+43 ; ..W ?55,$J($FN($P(BAR(BAR("L"),BAR("V")),U,5),",",2),12) ;total adjustment amount ;M819*DEL*TMM*20100801
+44 ; ..W ?66,$J($FN($P(BAR(BAR("L"),BAR("V")),U,6),",",2),13) ;total unpaid amount ;M819*DEL*TMM*20100801
+45 ; -----END DEL(1)---> ;M819*ADD*TMM*20100801-->replaced with ADD(1) section that follows
+46 ; ---BEGIN ADD(1)---> ;M819*ADD*TMM*20100801-->replaces DEL(1) section preceding this section
+47 ; Next line prints visit type
+48 IF $GET(BARTEXT)'=1
WRITE !?2
+49 IF $GET(BARTEXT)=1
WRITE !,"^"
+50 IF BARY("SORT")="V"
Begin DoDot:3
+51 ;(B)
IF BAR("V")=99999
WRITE "NO VISIT TYP"_$$TEXTCK^BARDRST()
QUIT
+52 ;(B)
IF $PIECE($GET(^ABMDVTYP(BAR("V"),0)),U)]""
WRITE $EXTRACT($PIECE(^ABMDVTYP(BAR("V"),0),U),1,12)_$$TEXTCK^BARDRST()
QUIT
+53 ;(B)
WRITE "DELETED ",BAR("V")_$$TEXTCK^BARDRST()
End DoDot:3
+54 IF '$TEST
Begin DoDot:3
+55 ;(B)
IF BAR("V")=99999
WRITE "NO CLINIC"_$$TEXTCK^BARDRST()
QUIT
+56 ;clinic stop name (B)
WRITE $EXTRACT($PIECE(^DIC(40.7,BAR("V"),0),U),1,12)_$$TEXTCK^BARDRST()
End DoDot:3
+57 IF $EXTRACT(BARTEXT)'=1
Begin DoDot:3
+58 ;number of visits
WRITE ?16,$JUSTIFY($FNUMBER($PIECE(BAR(BAR("L"),BAR("V")),U),",",0),5)
+59 ;total undup patients
WRITE ?22,$JUSTIFY($FNUMBER($PIECE(BAR(BAR("L"),BAR("V")),U,2),",",0),5)
End DoDot:3
+60 IF $EXTRACT(BARTEXT)=1
Begin DoDot:3
+61 ;number of visits (C)
WRITE $JUSTIFY($FNUMBER($PIECE(BAR(BAR("L"),BAR("V")),U),",",0),5)_"^"
+62 ;total undup patients (D)
WRITE $JUSTIFY($FNUMBER($PIECE(BAR(BAR("L"),BAR("V")),U,2),",",0),5)_"^"
End DoDot:3
+63 ;M1*TMM*11/13/2009 HEAT_8548
SET UNDUP=UNDUP+$PIECE(BAR(BAR("L"),BAR("V")),U,2)
+64 ; Next line writes $ with comma and cents
+65 IF $EXTRACT(BARTEXT)'=1
Begin DoDot:3
+66 ;total billed amount
WRITE ?27,$JUSTIFY($FNUMBER($PIECE(BAR(BAR("L"),BAR("V")),U,3),",",2),13)
+67 ;total paid amount
WRITE ?41,$JUSTIFY($FNUMBER($PIECE(BAR(BAR("L"),BAR("V")),U,4),",",2),12)
+68 ;total adjustment amount
WRITE ?55,$JUSTIFY($FNUMBER($PIECE(BAR(BAR("L"),BAR("V")),U,5),",",2),12)
+69 ;total unpaid amount
WRITE ?66,$JUSTIFY($FNUMBER($PIECE(BAR(BAR("L"),BAR("V")),U,6),",",2),13)
End DoDot:3
+70 IF $EXTRACT(BARTEXT)=1
Begin DoDot:3
+71 ;total billed amount (E)
WRITE $JUSTIFY($FNUMBER($PIECE(BAR(BAR("L"),BAR("V")),U,3),",",2),13)_"^"
+72 ;total paid amount (F)
WRITE $JUSTIFY($FNUMBER($PIECE(BAR(BAR("L"),BAR("V")),U,4),",",2),12)_"^"
+73 ;total adjustment amount (G)
WRITE $JUSTIFY($FNUMBER($PIECE(BAR(BAR("L"),BAR("V")),U,5),",",2),12)_"^"
+74 ;total unpaid amount (H)
WRITE $JUSTIFY($FNUMBER($PIECE(BAR(BAR("L"),BAR("V")),U,6),",",2),13)_"^"
End DoDot:3
+75 ; -----END ADD(1)---> ;M819*ADD*TMM*20100801-->replaces DEL section preceding this section
+76 SET BAR("N")=$PIECE(BAR(BAR("L"),BAR("V")),U,1)+BAR("N")
+77 SET BAR("NLN")=BAR("NLN")+$PIECE(BAR(BAR("L"),BAR("V")),U,1)
+78 SET BAR("B")=$PIECE(BAR(BAR("L"),BAR("V")),U,3)+BAR("B")
+79 SET BAR("NLB")=BAR("NLB")+$PIECE(BAR(BAR("L"),BAR("V")),U,3)
+80 SET BAR("P")=$PIECE(BAR(BAR("L"),BAR("V")),U,4)+BAR("P")
+81 SET BAR("NLP")=BAR("NLP")+$PIECE(BAR(BAR("L"),BAR("V")),U,4)
+82 SET BAR("A")=$PIECE(BAR(BAR("L"),BAR("V")),U,5)+BAR("A")
+83 SET BAR("NLA")=BAR("NLA")+$PIECE(BAR(BAR("L"),BAR("V")),U,5)
+84 SET BAR("C")=$PIECE(BAR(BAR("L"),BAR("V")),U,6)+BAR("C")
+85 ;S BAR("NLC")=BAR("NLC")+$P(BAR(BAR("L"),BAR("V")),U,6) ;MRS:BAR*1.8*10 H2260
+86 ;MRS:BAR*1.8*10 H2260
SET BAR("NLU")=BAR("NLU")+$PIECE(BAR(BAR("L"),BAR("V")),U,6)
End DoDot:2
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO XIT
+87 ;---BEGIN DEL(2)---> ;M819*ADD*TMM*20100801-->replaced with ADD(2) section that follows
+88 ; .W !,?15,"------",?22,"------",?30,"----------",?43,"----------",?57,"----------",?70,"----------"
+89 ; .W !?16,$J($FN(BAR("N"),",",0),5)
+90 ; .;W ?22,$J($FN(BAR("LC",BAR("L")),",",0),5) ;M1*TMM*11/13/2009 HEAT_8548
+91 ; .W ?22,$J($FN(UNDUP,",",0),5) ;M1*TMM*11/13/2009 HEAT_8548
+92 ; .W ?28,$J($FN(BAR("B"),",",2),12)
+93 ; .W ?40,$J($FN(BAR("P"),",",2),13)
+94 ; .W ?55,$J($FN(BAR("A"),",",2),12)
+95 ; .W ?67,$J($FN(BAR("C"),",",2),13)
+96 ; .;PRINT INPATIENT DAYS - WILL PRINT 0 DAYS ALSO
+97 ; .W !!
+98 ; .W "TOTAL COVERED INPATIENT DAYS ",+$GET(BAR(BAR("L"),"COVD"))
+99 ; .W !
+100 ; W !,?10,"END OF REPORT",!
+101 ; -----END DEL(2)---> ;M819*ADD*TMM*20100801-->replaced with ADD(2) section that follows
+102 ; ---BEGIN ADD(2)---> ;M819*ADD*TMM*20100801-->replaces DEL(2) section preceding this section
+103 ; Printer format
+104 IF $GET(BARTEXT)'=1
Begin DoDot:2
+105 WRITE !,?15,"------",?22,"------",?30,"----------",?43,"----------",?57,"----------",?70,"----------"
+106 WRITE !?16,$JUSTIFY($FNUMBER(BAR("N"),",",0),5)
+107 ;W ?22,$J($FN(BAR("LC",BAR("L")),",",0),5) ;M1*TMM*11/13/2009 HEAT_8548
+108 ;M1*TMM*11/13/2009 HEAT_8548
WRITE ?22,$JUSTIFY($FNUMBER(UNDUP,",",0),5)
+109 WRITE ?28,$JUSTIFY($FNUMBER(BAR("B"),",",2),12)
+110 WRITE ?40,$JUSTIFY($FNUMBER(BAR("P"),",",2),13)
+111 WRITE ?55,$JUSTIFY($FNUMBER(BAR("A"),",",2),12)
+112 WRITE ?67,$JUSTIFY($FNUMBER(BAR("C"),",",2),13)
End DoDot:2
+113 ; Delimited file format
+114 IF $GET(BARTEXT)=1
Begin DoDot:2
+115 WRITE !,"^^------^------^----------^----------^----------^----------"
+116 ;(C)
WRITE !,"^^",$JUSTIFY($FNUMBER(BAR("N"),",",0),5)
+117 ;W "^^",$J($FN(BAR("LC",BAR("L")),",",0),5) ;M1*TMM*11/13/2009 HEAT_8548
+118 ;(D) M1*TMM*11/13/2009 HEAT_8548
WRITE "^",$JUSTIFY($FNUMBER(UNDUP,",",0),5)
+119 ;(E)
WRITE "^",$JUSTIFY($FNUMBER(BAR("B"),",",2),12)
+120 ;(F)
WRITE "^",$JUSTIFY($FNUMBER(BAR("P"),",",2),13)
+121 ;(G)
WRITE "^",$JUSTIFY($FNUMBER(BAR("A"),",",2),12)
+122 ;(H)
WRITE "^",$JUSTIFY($FNUMBER(BAR("C"),",",2),13)
+123 ;PRINT INPATIENT DAYS - WILL PRINT 0 DAYS ALSO
End DoDot:2
+124 WRITE !!
+125 IF $GET(BARTEXT)'=1
WRITE "TOTAL COVERED INPATIENT DAYS ",+$GET(BAR(BAR("L"),"COVD"))
+126 IF $GET(BARTEXT)=1
WRITE "^TOTAL COVERED INPATIENT DAYS^",+$GET(BAR(BAR("L"),"COVD"))
+127 WRITE !
+128 WRITE !,"END OF REPORT",!
+129 ; -----END ADD(2)---> ;M819*ADD*TMM*20100801-->replaces DEL(2) section preceding this section
End DoDot:1
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO XIT
+130 ;
+131 IF $EXTRACT(IOST)="C"
IF '$DATA(IO("S"))
Begin DoDot:1
+132 KILL DIR
+133 SET DIR(0)="E"
+134 DO ^DIR
+135 KILL DIR
End DoDot:1
+136 IF BAR("NL")<3
GOTO XIT
+137 ; ---BEGIN DEL(3)---> ;M819*DEL*TMM*20100801 replaced with ADD(3) section that follows
+138 WRITE !,?17,"======",?25,"======",?29,"==========",?42,"==========",?67,"=========="
+139 ;TOOK OUT TOTAL UNDUP CNT 2/98 SL
+140 WRITE !?10,"Total:",?20,$JUSTIFY($FNUMBER(BAR("NLN"),",",0),5)
+141 WRITE ?29,$JUSTIFY($FNUMBER(BAR("NLB"),",",2),13)
+142 WRITE ?41,$JUSTIFY($FNUMBER(BAR("NLP"),",",2),13)
+143 WRITE ?55,$JUSTIFY($FNUMBER(BAR("NLA"),",",2),12)
+144 ;W ?67,$J($FN(BAR("NLC"),",",2),13) ;MRS:BAR*1.8*10 H2260
+145 ;MRS:BAR*1.8*10 H2260
WRITE ?67,$JUSTIFY($FNUMBER(BAR("NLU"),",",2),13)
+146 ; -----END DEL(3)---> ;M819*DEL*TMM*20100801 replaced with ADD(3) section that follows
+147 ; ---BEGIN DEL(3)---> ;M819*DEL*TMM*20100801 replaced with ADD(3) section that follows
+148 ; Printer format
+149 IF $GET(BARTEXT)'=1
Begin DoDot:1
+150 WRITE !,?17,"======",?25,"======",?29,"==========",?42,"==========",?67,"=========="
+151 ;TOOK OUT TOTAL UNDUP CNT 2/98 SL
+152 WRITE !?10,"Total:",?20,$JUSTIFY($FNUMBER(BAR("NLN"),",",0),5)
+153 WRITE ?29,$JUSTIFY($FNUMBER(BAR("NLB"),",",2),13)
+154 WRITE ?41,$JUSTIFY($FNUMBER(BAR("NLP"),",",2),13)
+155 WRITE ?55,$JUSTIFY($FNUMBER(BAR("NLA"),",",2),12)
+156 ;W ?67,$J($FN(BAR("NLC"),",",2),13) ;MRS:BAR*1.8*10 H2260
+157 ;MRS:BAR*1.8*10 H2260
WRITE ?67,$JUSTIFY($FNUMBER(BAR("NLU"),",",2),13)
End DoDot:1
+158 ; Delimited file format
+159 IF $GET(BARTEXT)=1
Begin DoDot:1
+160 WRITE !,"^======^======^==========^==========^=========="
+161 ;TOOK OUT TOTAL UNDUP CNT 2/98 SL
+162 WRITE !,"^^Total:^",$JUSTIFY($FNUMBER(BAR("NLN"),",",0),5)
+163 WRITE "^",$JUSTIFY($FNUMBER(BAR("NLB"),",",2),13)
+164 WRITE "^",$JUSTIFY($FNUMBER(BAR("NLP"),",",2),13)
+165 WRITE "^",$JUSTIFY($FNUMBER(BAR("NLA"),",",2),12)
+166 ;W ?67,$J($FN(BAR("NLC"),",",2),13) ;MRS:BAR*1.8*10 H2260
+167 ;MRS:BAR*1.8*10 H2260
WRITE "^",$JUSTIFY($FNUMBER(BAR("NLU"),",",2),13)
End DoDot:1
+168 ; -----END DEL(3)---> ;M819*DEL*TMM*20100801 replaced with ADD(3) section that follows
+169 GOTO XIT
+170 ; *********************************************************************
HD ;
+1 DO PAZ^BARRUTL
+2 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+3 ;
HDB ;
+1 SET BAR("PG")=BAR("PG")+1
+2 SET BAR("I")=""
+3 DO WHD^BARRHD
+4 ; ---BEGIN DEL(1)---> ;M819*ADD*TMM*20100731--> replaced by ADD(1) section that follows
+5 ;W !!?2,$S(BARY("SORT")="V":"VISIT",1:"") ;M819*DEL*TMM*20100731
+6 ;W ?15,"NUMBER",?22,"UNDUP",?35,"BILLED",?48,"PAID",?60,"ADJ",?74,"UNPAID" ;M819*DEL*TMM*20100731
+7 ;W !?2,$S(BARY("SORT")="V":"TYPE",1:"CLINIC") ;M819*DEL*TMM*20100731
+8 ;W ?15,"VISITS",?22,"PATIENTS",?35,"AMOUNT",?48,"AMOUNT",?60,"AMOUNT",?74,"AMOUNT" ;M819*DEL*TMM*20100731
+9 ;W !,"-------------------------------------------------------------------------------" ;M819*DEL*TMM*20100731
+10 ; -----END DEL(1)---> ;M819*ADD*TMM*20100731--> replaced by ADD(1) section that follows
+11 ; ---BEGIN ADD(1)---> ;M819*ADD*TMM*20100731--> replaces DEL(1) section that preceds this
+12 IF $GET(BARTEXT)'=1
Begin DoDot:1
+13 ;M819*DEL*TMM*20100731
WRITE !!?2,$SELECT(BARY("SORT")="V":"VISIT",1:"")
+14 WRITE ?15,"NUMBER",?22,"UNDUP",?35,"BILLED",?48,"PAID",?60,"ADJ",?74,"UNPAID"
+15 ;M819*DEL*TMM*20100731
WRITE !?2,$SELECT(BARY("SORT")="V":"TYPE",1:"CLINIC")
+16 WRITE ?15,"VISITS",?22,"PATIENTS",?35,"AMOUNT",?48,"AMOUNT",?60,"AMOUNT",?74,"AMOUNT"
+17 SET $PIECE(BARTMPLN,"-",80)=""
+18 WRITE !,BARTMPLN
End DoDot:1
+19 IF $GET(BARTEXT)=1
Begin DoDot:1
+20 WRITE !!,U,$SELECT(BARY("SORT")="V":"VISIT",1:"")
+21 WRITE U,"NUMBER",U,"UNDUP",U,"BILLED",U,"PAID",U,"ADJ",U,"UNPAID"
+22 WRITE !,U,$SELECT(BARY("SORT")="V":"TYPE",1:"CLINIC")
+23 WRITE U,"VISITS",U,"PATIENTS",U,"AMOUNT",U,"AMOUNT",U,"AMOUNT",U,"AMOUNT"
+24 SET $PIECE(BARTMPLN,"-",80)=""
+25 WRITE !,"^",BARTMPLN
End DoDot:1
+26 ; -----END ADD(1)---> ;M819*ADD*TMM*20100731--> replaces DEL(1) section that preceds thisQ
+27 ; *********************************************************************
XIT ;
+1 KILL ^TMP($JOB,"BAR-ST")
+2 QUIT
