BARBLOS1.m

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