BARBLOS1 ; IHS/SD/LSL - List Outstanding Balances by Insurer- Jan 17,1997 ;08/20/2008
;;1.8;IHS ACCOUNTS RECEIVABLE;**7**;OCT 26, 2005
;
; IHS/ADC/KMR P*2 JAN 2,1997 - Routine created
; MODIFIED TO CHANGE XTMP($J,"BARBLOS" TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892
; *********************************************************************
;
PRINT ;EP
; roll through the ^XTMP("BARBLOS",$J) and report on these records
S BARAPDT=$$SDT^BARDUTL(BARDATE) ;Y2000
S BARPG("HDR")="Outstanding Balances by Insurer for Bills approved by "_BARAPDT
S BARHDRA="N"
D BARHDR
I '$D(^XTMP("BARBLOS",$J)) W !!?15,"NO RECORDS TO BE LISTED" Q
S BARINSNO=""
S BARDATE=BARDATE
S (BARQUIT,BARTBILL,BARTCOLL,BARTGRP)=0
F S BARINSNO=$O(^XTMP("BARBLOS",$J,BARINSNO)) Q:BARINSNO="" Q:BARQUIT Q:BARINSNO="NO49REC" D Q:($G(DIROUT)!$G(DUOUT)!$G(DTOUT)!$G(DROUT))
. S (BARACTBL,BARACTCL,BARGRPDL)=0
. I BARINSNO'=0 D
.. I '$D(^BARAC(DUZ(2),BARINSNO)) S BARACTNM=" UNKNOWN "_BARINSNO Q
.. S BARACTNM=$$GET1^DIQ(90050.02,BARINSNO,.01)
. I BARINSNO=0 D
.. S BARACTNM=" UNKNOWN "
. I $D(^XTMP("BARBLOS",$J,BARINSNO,"BILLED")) D
.. S BARACTBL=^XTMP("BARBLOS",$J,BARINSNO,"BILLED")
.. S BARTBILL=BARTBILL+^XTMP("BARBLOS",$J,BARINSNO,"BILLED")
. I $D(^XTMP("BARBLOS",$J,BARINSNO,"COLLECTED")) D
.. S BARACTCL=^XTMP("BARBLOS",$J,BARINSNO,"COLLECTED")
.. S BARTCOLL=BARTCOLL+^XTMP("BARBLOS",$J,BARINSNO,"COLLECTED")
. I $D(^XTMP("BARBLOS",$J,BARINSNO,"GROUPER")) D
.. S BARGRPDL=^XTMP("BARBLOS",$J,BARINSNO,"GROUPER")
.. S BARTGRP=BARTGRP+^XTMP("BARBLOS",$J,BARINSNO,"GROUPER")
. S BARACTBA=BARACTBL-BARACTCL
. D WRTRPT
S BARTBA=BARTBILL-BARTCOLL
S BARTBLF=$FN(BARTBILL,",",2)
S BARTCLF=$FN(BARTCOLL,",",2)
S BARTBAF=$FN(BARTBA,",",2)
S BARTGRPF=$FN(BARTGRP,",",2)
W !!,?5,"TOTALS:"
W ?27,$J("",15-$L(BARTBLF))_BARTBLF
W ?43,$J("",15-$L(BARTCLF))_BARTCLF
W ?56,$J("",15-$L(BARTBAF))_BARTBAF
I $E(IOST)="C",IOT["TRM" D EOP^BARUTL(0)
D EBARPG
Q
; *********************************************************************
;
WRTRPT ;
; Write out the reports
S BARACTBF=$FN(BARACTBL,",",2)
S BARACTCF=$FN(BARACTCL,",",2)
S BARACTAF=$FN(BARACTBA,",",2)
S BARGRPDF=$FN(BARGRPDL,",",2)
W !!,$E(BARACTNM,1,25)
W ?29,$J("",13-$L(BARACTBF))_BARACTBF
W ?45,$J("",13-$L(BARACTCF))_BARACTCF
W ?59,$J("",13-$L(BARACTAF))_BARACTAF
D PG
Q
; *********************************************************************
;
PG ;**page controller
BARPG ;EP
; PAGE CONTROLLER
; This utility uses variables BARPG("HDR"),BARPG("DT"),BARPG("LINE"),BARPG("PG")
; kill variables by D EBARPG
;
Q:($Y<(IOSL-6))!($G(DOUT)!$G(DFOUT))
S:'$D(BARPG("PG")) BARPG("PG")=0
S BARPG("PG")=BARPG("PG")+1
I $E(IOST)="C",IOT["TRM" D EOP^BARUTL(0) Q:($G(DIROUT)!$G(DUOUT)!$G(DTOUT)!$G(DROUT))
;
Q ;
Q:($G(DIROUT)!$G(DUOUT)!$G(DTOUT)!$G(DROUT))
;
BARHDR ;
; Write the Report Header
W:$Y @IOF
W !
Q:'$D(BARPG("HDR"))
S:'$D(BARPG("LINE")) $P(BARPG("LINE"),"-",IOM-2)=""
S:'$D(BARPG("PG")) BARPG("PG")=1
I '$D(BARPG("DT")) D
. S %H=$H
. D YX^%DTC
. S BARPG("DT")=Y
U IO
W ?(IOM-$L(BARPG("HDR"))/2),BARPG("HDR")
W !?(IOM-75),BARPG("DT"),?(IOM-15),"PAGE: ",BARPG("PG"),!,BARPG("LINE")
;
BARHD ;EP
; Write column header / message
W !
I BARPG("HDR")'["mmary" D
. I BARHDRA="N" D
.. W ?8,"Insurer",?31," Billed Amt ",?45,"Accounted For",?60," Outstanding"
I ($G(DIROUT)!$G(DUOUT)!$G(DTOUT)!$G(DROUT)) S BARQUIT=1
Q
; *********************************************************************
;
EBARPG ;
K BARPG("LINE"),BARPG("PG"),BARPG("HDR"),BARPG("DT")
Q
; *********************************************************************
;
EXIT ; Exit routine
Q
BARBLOS1 ; IHS/SD/LSL - List Outstanding Balances by Insurer- Jan 17,1997 ;08/20/2008
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**7**;OCT 26, 2005
+2 ;
+3 ; IHS/ADC/KMR P*2 JAN 2,1997 - Routine created
+4 ; MODIFIED TO CHANGE XTMP($J,"BARBLOS" TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892
+5 ; *********************************************************************
+6 ;
PRINT ;EP
+1 ; roll through the ^XTMP("BARBLOS",$J) and report on these records
+2 ;Y2000
SET BARAPDT=$$SDT^BARDUTL(BARDATE)
+3 SET BARPG("HDR")="Outstanding Balances by Insurer for Bills approved by "_BARAPDT
+4 SET BARHDRA="N"
+5 DO BARHDR
+6 IF '$DATA(^XTMP("BARBLOS",$JOB))
WRITE !!?15,"NO RECORDS TO BE LISTED"
QUIT
+7 SET BARINSNO=""
+8 SET BARDATE=BARDATE
+9 SET (BARQUIT,BARTBILL,BARTCOLL,BARTGRP)=0
+10 FOR
SET BARINSNO=$ORDER(^XTMP("BARBLOS",$JOB,BARINSNO))
IF BARINSNO=""
QUIT
IF BARQUIT
QUIT
IF BARINSNO="NO49REC"
QUIT
Begin DoDot:1
+11 SET (BARACTBL,BARACTCL,BARGRPDL)=0
+12 IF BARINSNO'=0
Begin DoDot:2
+13 IF '$DATA(^BARAC(DUZ(2),BARINSNO))
SET BARACTNM=" UNKNOWN "_BARINSNO
QUIT
+14 SET BARACTNM=$$GET1^DIQ(90050.02,BARINSNO,.01)
End DoDot:2
+15 IF BARINSNO=0
Begin DoDot:2
+16 SET BARACTNM=" UNKNOWN "
End DoDot:2
+17 IF $DATA(^XTMP("BARBLOS",$JOB,BARINSNO,"BILLED"))
Begin DoDot:2
+18 SET BARACTBL=^XTMP("BARBLOS",$JOB,BARINSNO,"BILLED")
+19 SET BARTBILL=BARTBILL+^XTMP("BARBLOS",$JOB,BARINSNO,"BILLED")
End DoDot:2
+20 IF $DATA(^XTMP("BARBLOS",$JOB,BARINSNO,"COLLECTED"))
Begin DoDot:2
+21 SET BARACTCL=^XTMP("BARBLOS",$JOB,BARINSNO,"COLLECTED")
+22 SET BARTCOLL=BARTCOLL+^XTMP("BARBLOS",$JOB,BARINSNO,"COLLECTED")
End DoDot:2
+23 IF $DATA(^XTMP("BARBLOS",$JOB,BARINSNO,"GROUPER"))
Begin DoDot:2
+24 SET BARGRPDL=^XTMP("BARBLOS",$JOB,BARINSNO,"GROUPER")
+25 SET BARTGRP=BARTGRP+^XTMP("BARBLOS",$JOB,BARINSNO,"GROUPER")
End DoDot:2
+26 SET BARACTBA=BARACTBL-BARACTCL
+27 DO WRTRPT
End DoDot:1
IF ($GET(DIROUT)!$GET(DUOUT)!$GET(DTOUT)!$GET(DROUT))
QUIT
+28 SET BARTBA=BARTBILL-BARTCOLL
+29 SET BARTBLF=$FNUMBER(BARTBILL,",",2)
+30 SET BARTCLF=$FNUMBER(BARTCOLL,",",2)
+31 SET BARTBAF=$FNUMBER(BARTBA,",",2)
+32 SET BARTGRPF=$FNUMBER(BARTGRP,",",2)
+33 WRITE !!,?5,"TOTALS:"
+34 WRITE ?27,$JUSTIFY("",15-$LENGTH(BARTBLF))_BARTBLF
+35 WRITE ?43,$JUSTIFY("",15-$LENGTH(BARTCLF))_BARTCLF
+36 WRITE ?56,$JUSTIFY("",15-$LENGTH(BARTBAF))_BARTBAF
+37 IF $EXTRACT(IOST)="C"
IF IOT["TRM"
DO EOP^BARUTL(0)
+38 DO EBARPG
+39 QUIT
+40 ; *********************************************************************
+41 ;
WRTRPT ;
+1 ; Write out the reports
+2 SET BARACTBF=$FNUMBER(BARACTBL,",",2)
+3 SET BARACTCF=$FNUMBER(BARACTCL,",",2)
+4 SET BARACTAF=$FNUMBER(BARACTBA,",",2)
+5 SET BARGRPDF=$FNUMBER(BARGRPDL,",",2)
+6 WRITE !!,$EXTRACT(BARACTNM,1,25)
+7 WRITE ?29,$JUSTIFY("",13-$LENGTH(BARACTBF))_BARACTBF
+8 WRITE ?45,$JUSTIFY("",13-$LENGTH(BARACTCF))_BARACTCF
+9 WRITE ?59,$JUSTIFY("",13-$LENGTH(BARACTAF))_BARACTAF
+10 DO PG
+11 QUIT
+12 ; *********************************************************************
+13 ;
PG ;**page controller
BARPG ;EP
+1 ; PAGE CONTROLLER
+2 ; This utility uses variables BARPG("HDR"),BARPG("DT"),BARPG("LINE"),BARPG("PG")
+3 ; kill variables by D EBARPG
+4 ;
+5 IF ($Y<(IOSL-6))!($GET(DOUT)!$GET(DFOUT))
QUIT
+6 IF '$DATA(BARPG("PG"))
SET BARPG("PG")=0
+7 SET BARPG("PG")=BARPG("PG")+1
+8 IF $EXTRACT(IOST)="C"
IF IOT["TRM"
DO EOP^BARUTL(0)
IF ($GET(DIROUT)!$GET(DUOUT)!$GET(DTOUT)!$GET(DROUT))
QUIT
+9 ;
Q ;
+1 IF ($GET(DIROUT)!$GET(DUOUT)!$GET(DTOUT)!$GET(DROUT))
QUIT
+2 ;
BARHDR ;
+1 ; Write the Report Header
+2 IF $Y
WRITE @IOF
+3 WRITE !
+4 IF '$DATA(BARPG("HDR"))
QUIT
+5 IF '$DATA(BARPG("LINE"))
SET $PIECE(BARPG("LINE"),"-",IOM-2)=""
+6 IF '$DATA(BARPG("PG"))
SET BARPG("PG")=1
+7 IF '$DATA(BARPG("DT"))
Begin DoDot:1
+8 SET %H=$HOROLOG
+9 DO YX^%DTC
+10 SET BARPG("DT")=Y
End DoDot:1
+11 USE IO
+12 WRITE ?(IOM-$LENGTH(BARPG("HDR"))/2),BARPG("HDR")
+13 WRITE !?(IOM-75),BARPG("DT"),?(IOM-15),"PAGE: ",BARPG("PG"),!,BARPG("LINE")
+14 ;
BARHD ;EP
+1 ; Write column header / message
+2 WRITE !
+3 IF BARPG("HDR")'["mmary"
Begin DoDot:1
+4 IF BARHDRA="N"
Begin DoDot:2
+5 WRITE ?8,"Insurer",?31," Billed Amt ",?45,"Accounted For",?60," Outstanding"
End DoDot:2
End DoDot:1
+6 IF ($GET(DIROUT)!$GET(DUOUT)!$GET(DTOUT)!$GET(DROUT))
SET BARQUIT=1
+7 QUIT
+8 ; *********************************************************************
+9 ;
EBARPG ;
+1 KILL BARPG("LINE"),BARPG("PG"),BARPG("HDR"),BARPG("DT")
+2 QUIT
+3 ; *********************************************************************
+4 ;
EXIT ; Exit routine
+1 QUIT
