BARRAOI.m

BARRAOI ; IHS/SD/LSL - AGE OPEN ITEMS RPT JAN 16,1997 ;08/20/2008

 ;;1.8;IHS ACCOUNTS RECEIVABLE;**7**;OCT 26, 2005

 ;

 ; IHS/SD/LSL - 03/11/03 - Routine created

 ;        Replaces BARRAGED

 ; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892

 ; ********************************************************************

EN ; EP

 ;

 K BARY,BAR,BARP

 S BAR("PRIVACY")=1                   ; Privacy act applies

 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"

 D ASKQUES                            ; Ask user questions

 Q:$D(DTOUT)!$D(DUOUT)

 D SETHDR

 S BARQ("RC")="COMPUTE^BARRAOI"    ; Compute routine

 S BARQ("RP")="PRINT^BARRAOI"      ; Print routine

 S BARQ("NS")="BAR"                   ; Namespace for variables

 S BARQ("RX")="POUT^BARRUTL"          ; Clean-up routine

 D ^BARDBQUE                          ; Double queuing

 D PAZ^BARRUTL

 Q

 ; ********************************************************************

 ;

ASKQUES ;

 ; Ask user questions

 D MSG^BARRSEL                        ; Message about BILL/VIS loc

 D LOC^BARRSL1                        ; Ask loc - return BARY("LOC")

 Q:$D(DTOUT)!($D(DUOUT))              ; Q if time or "^" out

 W:'$D(BARY("LOC")) "ALL"

 D AGE                                ; Ask age group - return BARAGE

 Q:$D(DTOUT)!($D(DUOUT))

 D ASKAP                              ; Ask Patient or Insurer

 Q:$D(DTOUT)!($D(DUOUT))

 I BARAP="P" D  Q:($D(DTOUT)!($D(DUOUT)))

 . D ASKPAT

 . Q:$D(DTOUT)!($D(DUOUT))

 . W:'$D(BARY("PAT")) "ALL"

 I BARAP="I" D  Q:($D(DTOUT)!($D(DUOUT)))

 . D ACCT

 . Q:$D(DTOUT)!($D(DUOUT))

 . W:'$D(BARY("ACCT")) "ALL"

 K DIR,DIC,X,Y,DA

 Q

 ; ********************************************************************

 ;

AGE ;

 ; Ask user to select age group for bill

 K DIR

 S DIR(0)="S^1:0-30;2:31-60;3:61-90;4:91-120;5:120+"

 S DIR("A")="Select aging range for bills"

 D ^DIR

 I Y<0!($D(DUOUT))!($D(DTOUT)) Q

 S BAR("SELECTION")=Y(0)

 S:Y=5 BAR("SELECTION")="OVER 120"

 S BARAGE=$S(Y=1:7.3,Y=2:7.4,Y=3:7.5,Y=4:7.6,Y=5:7.7)

 Q

 ; ********************************************************************

 ;

ASKAP ;

 ; Ask user if want report by insurer or payer

 S (BARY("OBAL"),BARY("STCR"))=1      ; Need to loop "OBAL" x-ref

 S BARAP="I"

 K DIR

 S DIR(0)="SO^I:INSURER;P:PATIENT"

 S DIR("B")="I"

 S DIR("A")="Should the report contain data for Insurer or Patient (I/P)"

 D ^DIR

 I Y=""!($D(DUOUT))!($D(DTOUT)) Q

 S BARAP=Y

 S BARAP("NAME")=Y(0)

 Q

 ; ********************************************************************

 ;

ASKPAT ;

 ; Ask user for Patient Name

 K DIC,BARZ

 S DIC="^AUPNPAT("

 S DIC(0)="IAEMQZ"

 S DIC("A")="Select Patient: "

 S DIC("S")="I $D(^BARBL(DUZ(2),""ABC"",Y))"

 D ^DIC

 K DIC

 Q:+Y<0

 K BARY("OBAL"),BARY("STCR")

 S BARY("PAT")=+Y

 S BARY("PAT","NM")=$P($G(^DPT(+BARY("PAT"),0)),U)

 Q

 ; ********************************************************************

 ;

ACCT ;

 ; Ask user for AR Account

 W !

 K DIC

 S DIC("A")="Select Insurer or press <RETURN> for all Insurers: "

 S DIC="90050.02"

 S DIC(0)="AEMQZ"

 S DIC("S")="I $P(^(0),U,10)=$$GET1^DIQ(200,DUZ,29,""I"")"

 K DD,DO

 D ^DIC

 Q:$D(DTOUT)!($D(DUOUT))

 Q:+Y<0

 K BARY("OBAL"),BARY("STCR")

 S BARY("ACCT")=+Y

 S BARY("ACCT","NM")=Y(0,0)

 Q

 ; ********************************************************************

 ;

SETHDR ;

 ; Set Header array

 S BAR("HD",0)=""

 S BAR("TXT")="Aged Open Items Report"

 S BAR("LVL")=0

 S BAR("CONJ")=""

 D CHK^BARRHD                         ; Line 1 of Report header

 S BAR("LVL")=BAR("LVL")+1

 S BAR("HD",BAR("LVL"))=""

 S BAR("TXT")="Bills "_BAR("SELECTION")_" days old"

 S BAR("CONJ")="for "

 D CHK^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"

 S BAR("CONJ")="at "

 D CHK^BARRHD

 Q

 ; ********************************************************************

 ; ********************************************************************

 ;

COMPUTE ; EP

 S BAR("SUBR")="BAR-AOI"

 S BARP("RTN")="BARRAOI"

 K ^TMP($J,"BAR-AOI")

 I BAR("LOC")="BILLING" D LOOP^BARRUTL Q

 S BARDUZ2=DUZ(2)

 S DUZ(2)=0

 F  S DUZ(2)=$O(^BARBL(DUZ(2))) Q:'DUZ(2)  D LOOP^BARRUTL

 S DUZ(2)=BARDUZ2

 Q

 ; ********************************************************************

 ;

DATA ; EP

 S BARP("HIT")=0

 D BILL^BARRCHK

 Q:'BARP("HIT")

 S BARAMT=$$GET1^DIQ(90050.01,BAR,BARAGE)

 Q:'+BARAMT                           ; Bill not right age

 S BARLOC=""

 S:BAR("L")]"" BARLOC=$$VAL^XBDIQ1(4,BAR("L"),.01)

 S:BARLOC="" BARLOC="No Visit Location"       ; Visit Location Name

 S BARACCT=""

 S:BAR("I")]"" BARACCT=$$VAL^XBDIQ1(90050.02,BAR("I"),.01)

 S:BARACCT="" BARACCT="No A/R Account"        ; A/R Account Name

 S BARPAT=""

 S:BAR("P")]"" BARPAT=$$VAL^XBDIQ1(9000001,BAR("P"),.01)

 S:BARPAT="" BARPAT="No Patient Name"         ; Patient Name

 S BARBILL=$P(BAR(0),U)                       ; Bill Number

 ;

 S ^TMP($J,"BAR-AOI",BARLOC,BARACCT,BARPAT,BARBILL)=BAR("D")_U_BARAMT

 ;

 S BARHOLD=$G(^TMP($J,"BAR-AOI",BARLOC,BARACCT))

 S ^TMP($J,"BAR-AOI",BARLOC,BARACCT)=BARHOLD+BARAMT

 ;

 S BARHOLD=$G(^TMP($J,"BAR-AOI",BARLOC))

 S ^TMP($J,"BAR-AOI",BARLOC)=BARHOLD+BARAMT

 ;

 S BARHOLD=$G(^TMP($J,"BAR-AOI"))

 S ^TMP($J,"BAR-AOI")=BARHOLD+BARAMT

 Q

 ; ********************************************************************

 ; ********************************************************************

 ;

PRINT ; EP

 K BARHOLD,BARAMT,BARBILL,BARPAT,BARACCT,BARLOC,BAR("D")

 S BAR("PG")=0

 S BAR("COL")="W !?6,""PATIENT NAME"",?30,""BILL NUMBER"",?56,""DOS"",?68,BAR(""SELECTION"")"

 D HDB^BARRPSRB

 I '$D(^TMP($J,"BAR-AOI")) D  Q           ; No data - quit

 . W !!!!!?25,"*** NO DATA TO PRINT ***"

 . D EOP^BARUTL(0)

 S BARLOC=""

 F  S BARLOC=$O(^TMP($J,"BAR-AOI",BARLOC)) Q:BARLOC=""  D LOC Q:$G(BAR("F1"))

 D TOTAL

 Q

 ; ********************************************************************

 ;

LOC ;

 ; For each Location do

 W !?5,"VISIT Location:  ",BARLOC

 S BARACCT=""

 F  S BARACCT=$O(^TMP($J,"BAR-AOI",BARLOC,BARACCT)) Q:BARACCT=""  D ACCOUNT Q:$G(BAR("F1"))

 D LOCTOTAL

 Q

 ; ********************************************************************

 ;

ACCOUNT ;

 ; For each AR Account w/in Visit location Do

 W !?10,"A/R Account:  ",BARACCT,!

 S BARPAT=""

 F  S BARPAT=$O(^TMP($J,"BAR-AOI",BARLOC,BARACCT,BARPAT)) Q:BARPAT=""  D PAT Q:$G(BAR("F1"))

 D ACCTOTAL

 Q

 ; ********************************************************************

 ;

PAT ;

 ; For each patient w/in AR Account w/in Visit location do

 S BARBILL=""

 F  S BARBILL=$O(^TMP($J,"BAR-AOI",BARLOC,BARACCT,BARPAT,BARBILL)) Q:BARBILL=""  D DETAIL Q:$G(BAR("F1"))

 Q

 ; ********************************************************************

 ;

DETAIL ;

 ; Write detail line of report

 I $Y>(IOSL-5) D HD^BARRPSRB Q:$G(BAR("F1"))

 S BARTMP=$G(^TMP($J,"BAR-AOI",BARLOC,BARACCT,BARPAT,BARBILL))

 W !?3,$E(BARPAT,1,25)                ; Patient Name

 W ?30,$E(BARBILL,1,20)               ; Bill Name

 W ?52,$$SDT^BARDUTL($P(BARTMP,U))    ; DOS

 W ?64,$J($FN($P(BARTMP,U,2),",",2),12)   ; $ amt aged

 Q

 ; ********************************************************************

 ;

ACCTOTAL ;

 ; A/R Account total

 W !?64,"------------"

 W !?5,"  * ",$E(BARACCT,1,45)," TOTAL"

 W ?63,$J($FN(^TMP($J,"BAR-AOI",BARLOC,BARACCT),",",2),13),!

 Q

 ; ********************************************************************

 ;

LOCTOTAL ;

 ; Visit location total

 W ?64,"------------"

 W !?5," ** ",$E(BARLOC,1,45)," TOTAL"

 W ?63,$J($FN(^TMP($J,"BAR-AOI",BARLOC),",",2),13),!

 Q

 ; ********************************************************************

 ;

TOTAL ;

 ; Report Total

 W ?64,"============"

 W !?5,"*** REPORT TOTAL"

 W ?62,$J($FN(^TMP($J,"BAR-AOI"),",",2),14)

 Q

BARRAOI   ; IHS/SD/LSL - AGE OPEN ITEMS RPT JAN 16,1997 ;08/20/2008

 +1       ;;1.8;IHS ACCOUNTS RECEIVABLE;**7**;OCT 26, 2005

 +2       ;

 +3       ; IHS/SD/LSL - 03/11/03 - Routine created

 +4       ;        Replaces BARRAGED

 +5       ; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892

 +6       ; ********************************************************************

EN        ; EP

 +1       ;

 +2        KILL BARY,BAR,BARP

 +3       ; Privacy act applies

           SET BAR("PRIVACY")=1

 +4       ; Set A/R basic variable

           IF '$DATA(BARUSR)

               DO INIT^BARUTL

 +5       ; BILLING or VISIT

           SET BAR("LOC")=$$GET1^DIQ(90052.06,DUZ(2),16)

 +6        IF BAR("LOC")=""

               SET BAR("LOC")="VISIT"

 +7       ; Ask user questions

           DO ASKQUES

 +8        IF $DATA(DTOUT)!$DATA(DUOUT)

               QUIT 

 +9        DO SETHDR

 +10      ; Compute routine

           SET BARQ("RC")="COMPUTE^BARRAOI"

 +11      ; Print routine

           SET BARQ("RP")="PRINT^BARRAOI"

 +12      ; Namespace for variables

           SET BARQ("NS")="BAR"

 +13      ; Clean-up routine

           SET BARQ("RX")="POUT^BARRUTL"

 +14      ; Double queuing

           DO ^BARDBQUE

 +15       DO PAZ^BARRUTL

 +16       QUIT 

 +17      ; ********************************************************************

 +18      ;

ASKQUES   ;

 +1       ; Ask user questions

 +2       ; Message about BILL/VIS loc

           DO MSG^BARRSEL

 +3       ; Ask loc - return BARY("LOC")

           DO LOC^BARRSL1

 +4       ; Q if time or "^" out

           IF $DATA(DTOUT)!($DATA(DUOUT))

               QUIT 

 +5        IF '$DATA(BARY("LOC"))

               WRITE "ALL"

 +6       ; Ask age group - return BARAGE

           DO AGE

 +7        IF $DATA(DTOUT)!($DATA(DUOUT))

               QUIT 

 +8       ; Ask Patient or Insurer

           DO ASKAP

 +9        IF $DATA(DTOUT)!($DATA(DUOUT))

               QUIT 

 +10       IF BARAP="P"

               Begin DoDot:1

 +11               DO ASKPAT

 +12               IF $DATA(DTOUT)!($DATA(DUOUT))

                       QUIT 

 +13               IF '$DATA(BARY("PAT"))

                       WRITE "ALL"

               End DoDot:1

               IF ($DATA(DTOUT)!($DATA(DUOUT)))

                   QUIT 

 +14       IF BARAP="I"

               Begin DoDot:1

 +15               DO ACCT

 +16               IF $DATA(DTOUT)!($DATA(DUOUT))

                       QUIT 

 +17               IF '$DATA(BARY("ACCT"))

                       WRITE "ALL"

               End DoDot:1

               IF ($DATA(DTOUT)!($DATA(DUOUT)))

                   QUIT 

 +18       KILL DIR,DIC,X,Y,DA

 +19       QUIT 

 +20      ; ********************************************************************

 +21      ;

AGE       ;

 +1       ; Ask user to select age group for bill

 +2        KILL DIR

 +3        SET DIR(0)="S^1:0-30;2:31-60;3:61-90;4:91-120;5:120+"

 +4        SET DIR("A")="Select aging range for bills"

 +5        DO ^DIR

 +6        IF Y<0!($DATA(DUOUT))!($DATA(DTOUT))

               QUIT 

 +7        SET BAR("SELECTION")=Y(0)

 +8        IF Y=5

               SET BAR("SELECTION")="OVER 120"

 +9        SET BARAGE=$SELECT(Y=1:7.3,Y=2:7.4,Y=3:7.5,Y=4:7.6,Y=5:7.7)

 +10       QUIT 

 +11      ; ********************************************************************

 +12      ;

ASKAP     ;

 +1       ; Ask user if want report by insurer or payer

 +2       ; Need to loop "OBAL" x-ref

           SET (BARY("OBAL"),BARY("STCR"))=1

 +3        SET BARAP="I"

 +4        KILL DIR

 +5        SET DIR(0)="SO^I:INSURER;P:PATIENT"

 +6        SET DIR("B")="I"

 +7        SET DIR("A")="Should the report contain data for Insurer or Patient (I/P)"

 +8        DO ^DIR

 +9        IF Y=""!($DATA(DUOUT))!($DATA(DTOUT))

               QUIT 

 +10       SET BARAP=Y

 +11       SET BARAP("NAME")=Y(0)

 +12       QUIT 

 +13      ; ********************************************************************

 +14      ;

ASKPAT    ;

 +1       ; Ask user for Patient Name

 +2        KILL DIC,BARZ

 +3        SET DIC="^AUPNPAT("

 +4        SET DIC(0)="IAEMQZ"

 +5        SET DIC("A")="Select Patient: "

 +6        SET DIC("S")="I $D(^BARBL(DUZ(2),""ABC"",Y))"

 +7        DO ^DIC

 +8        KILL DIC

 +9        IF +Y<0

               QUIT 

 +10       KILL BARY("OBAL"),BARY("STCR")

 +11       SET BARY("PAT")=+Y

 +12       SET BARY("PAT","NM")=$PIECE($GET(^DPT(+BARY("PAT"),0)),U)

 +13       QUIT 

 +14      ; ********************************************************************

 +15      ;

ACCT      ;

 +1       ; Ask user for AR Account

 +2        WRITE !

 +3        KILL DIC

 +4        SET DIC("A")="Select Insurer or press <RETURN> for all Insurers: "

 +5        SET DIC="90050.02"

 +6        SET DIC(0)="AEMQZ"

 +7        SET DIC("S")="I $P(^(0),U,10)=$$GET1^DIQ(200,DUZ,29,""I"")"

 +8        KILL DD,DO

 +9        DO ^DIC

 +10       IF $DATA(DTOUT)!($DATA(DUOUT))

               QUIT 

 +11       IF +Y<0

               QUIT 

 +12       KILL BARY("OBAL"),BARY("STCR")

 +13       SET BARY("ACCT")=+Y

 +14       SET BARY("ACCT","NM")=Y(0,0)

 +15       QUIT 

 +16      ; ********************************************************************

 +17      ;

SETHDR    ;

 +1       ; Set Header array

 +2        SET BAR("HD",0)=""

 +3        SET BAR("TXT")="Aged Open Items Report"

 +4        SET BAR("LVL")=0

 +5        SET BAR("CONJ")=""

 +6       ; Line 1 of Report header

           DO CHK^BARRHD

 +7        SET BAR("LVL")=BAR("LVL")+1

 +8        SET BAR("HD",BAR("LVL"))=""

 +9        SET BAR("TXT")="Bills "_BAR("SELECTION")_" days old"

 +10       SET BAR("CONJ")="for "

 +11       DO CHK^BARRHD

 +12       SET BAR("TXT")="ALL"

 +13       IF $DATA(BARY("LOC"))

               SET BAR("TXT")=$PIECE(^DIC(4,BARY("LOC"),0),U)

 +14       IF BAR("LOC")="BILLING"

               Begin DoDot:1

 +15               SET BAR("TXT")=BAR("TXT")_" Visit location(s) under "

 +16               SET BAR("TXT")=BAR("TXT")_$PIECE(^DIC(4,DUZ(2),0),U)

 +17               SET BAR("TXT")=BAR("TXT")_" Billing Location"

               End DoDot:1

 +18      IF '$TEST

               SET BAR("TXT")=BAR("TXT")_" Visit location(s) regardless of Billing Location"

 +19       SET BAR("CONJ")="at "

 +20       DO CHK^BARRHD

 +21       QUIT 

 +22      ; ********************************************************************

 +23      ; ********************************************************************

 +24      ;

COMPUTE   ; EP

 +1        SET BAR("SUBR")="BAR-AOI"

 +2        SET BARP("RTN")="BARRAOI"

 +3        KILL ^TMP($JOB,"BAR-AOI")

 +4        IF BAR("LOC")="BILLING"

               DO LOOP^BARRUTL

               QUIT 

 +5        SET BARDUZ2=DUZ(2)

 +6        SET DUZ(2)=0

 +7        FOR 

               SET DUZ(2)=$ORDER(^BARBL(DUZ(2)))

               IF 'DUZ(2)

                   QUIT 

               DO LOOP^BARRUTL

 +8        SET DUZ(2)=BARDUZ2

 +9        QUIT 

 +10      ; ********************************************************************

 +11      ;

DATA      ; EP

 +1        SET BARP("HIT")=0

 +2        DO BILL^BARRCHK

 +3        IF 'BARP("HIT")

               QUIT 

 +4        SET BARAMT=$$GET1^DIQ(90050.01,BAR,BARAGE)

 +5       ; Bill not right age

           IF '+BARAMT

               QUIT 

 +6        SET BARLOC=""

 +7        IF BAR("L")]""

               SET BARLOC=$$VAL^XBDIQ1(4,BAR("L"),.01)

 +8       ; Visit Location Name

           IF BARLOC=""

               SET BARLOC="No Visit Location"

 +9        SET BARACCT=""

 +10       IF BAR("I")]""

               SET BARACCT=$$VAL^XBDIQ1(90050.02,BAR("I"),.01)

 +11      ; A/R Account Name

           IF BARACCT=""

               SET BARACCT="No A/R Account"

 +12       SET BARPAT=""

 +13       IF BAR("P")]""

               SET BARPAT=$$VAL^XBDIQ1(9000001,BAR("P"),.01)

 +14      ; Patient Name

           IF BARPAT=""

               SET BARPAT="No Patient Name"

 +15      ; Bill Number

           SET BARBILL=$PIECE(BAR(0),U)

 +16      ;

 +17       SET ^TMP($JOB,"BAR-AOI",BARLOC,BARACCT,BARPAT,BARBILL)=BAR("D")_U_BARAMT

 +18      ;

 +19       SET BARHOLD=$GET(^TMP($JOB,"BAR-AOI",BARLOC,BARACCT))

 +20       SET ^TMP($JOB,"BAR-AOI",BARLOC,BARACCT)=BARHOLD+BARAMT

 +21      ;

 +22       SET BARHOLD=$GET(^TMP($JOB,"BAR-AOI",BARLOC))

 +23       SET ^TMP($JOB,"BAR-AOI",BARLOC)=BARHOLD+BARAMT

 +24      ;

 +25       SET BARHOLD=$GET(^TMP($JOB,"BAR-AOI"))

 +26       SET ^TMP($JOB,"BAR-AOI")=BARHOLD+BARAMT

 +27       QUIT 

 +28      ; ********************************************************************

 +29      ; ********************************************************************

 +30      ;

PRINT     ; EP

 +1        KILL BARHOLD,BARAMT,BARBILL,BARPAT,BARACCT,BARLOC,BAR("D")

 +2        SET BAR("PG")=0

 +3        SET BAR("COL")="W !?6,""PATIENT NAME"",?30,""BILL NUMBER"",?56,""DOS"",?68,BAR(""SELECTION"")"

 +4        DO HDB^BARRPSRB

 +5       ; No data - quit

           IF '$DATA(^TMP($JOB,"BAR-AOI"))

               Begin DoDot:1

 +6                WRITE !!!!!?25,"*** NO DATA TO PRINT ***"

 +7                DO EOP^BARUTL(0)

               End DoDot:1

               QUIT 

 +8        SET BARLOC=""

 +9        FOR 

               SET BARLOC=$ORDER(^TMP($JOB,"BAR-AOI",BARLOC))

               IF BARLOC=""

                   QUIT 

               DO LOC

               IF $GET(BAR("F1"))

                   QUIT 

 +10       DO TOTAL

 +11       QUIT 

 +12      ; ********************************************************************

 +13      ;

LOC       ;

 +1       ; For each Location do

 +2        WRITE !?5,"VISIT Location:  ",BARLOC

 +3        SET BARACCT=""

 +4        FOR 

               SET BARACCT=$ORDER(^TMP($JOB,"BAR-AOI",BARLOC,BARACCT))

               IF BARACCT=""

                   QUIT 

               DO ACCOUNT

               IF $GET(BAR("F1"))

                   QUIT 

 +5        DO LOCTOTAL

 +6        QUIT 

 +7       ; ********************************************************************

 +8       ;

ACCOUNT   ;

 +1       ; For each AR Account w/in Visit location Do

 +2        WRITE !?10,"A/R Account:  ",BARACCT,!

 +3        SET BARPAT=""

 +4        FOR 

               SET BARPAT=$ORDER(^TMP($JOB,"BAR-AOI",BARLOC,BARACCT,BARPAT))

               IF BARPAT=""

                   QUIT 

               DO PAT

               IF $GET(BAR("F1"))

                   QUIT 

 +5        DO ACCTOTAL

 +6        QUIT 

 +7       ; ********************************************************************

 +8       ;

PAT       ;

 +1       ; For each patient w/in AR Account w/in Visit location do

 +2        SET BARBILL=""

 +3        FOR 

               SET BARBILL=$ORDER(^TMP($JOB,"BAR-AOI",BARLOC,BARACCT,BARPAT,BARBILL))

               IF BARBILL=""

                   QUIT 

               DO DETAIL

               IF $GET(BAR("F1"))

                   QUIT 

 +4        QUIT 

 +5       ; ********************************************************************

 +6       ;

DETAIL    ;

 +1       ; Write detail line of report

 +2        IF $Y>(IOSL-5)

               DO HD^BARRPSRB

               IF $GET(BAR("F1"))

                   QUIT 

 +3        SET BARTMP=$GET(^TMP($JOB,"BAR-AOI",BARLOC,BARACCT,BARPAT,BARBILL))

 +4       ; Patient Name

           WRITE !?3,$EXTRACT(BARPAT,1,25)

 +5       ; Bill Name

           WRITE ?30,$EXTRACT(BARBILL,1,20)

 +6       ; DOS

           WRITE ?52,$$SDT^BARDUTL($PIECE(BARTMP,U))

 +7       ; $ amt aged

           WRITE ?64,$JUSTIFY($FNUMBER($PIECE(BARTMP,U,2),",",2),12)

 +8        QUIT 

 +9       ; ********************************************************************

 +10      ;

ACCTOTAL  ;

 +1       ; A/R Account total

 +2        WRITE !?64,"------------"

 +3        WRITE !?5,"  * ",$EXTRACT(BARACCT,1,45)," TOTAL"

 +4        WRITE ?63,$JUSTIFY($FNUMBER(^TMP($JOB,"BAR-AOI",BARLOC,BARACCT),",",2),13),!

 +5        QUIT 

 +6       ; ********************************************************************

 +7       ;

LOCTOTAL  ;

 +1       ; Visit location total

 +2        WRITE ?64,"------------"

 +3        WRITE !?5," ** ",$EXTRACT(BARLOC,1,45)," TOTAL"

 +4        WRITE ?63,$JUSTIFY($FNUMBER(^TMP($JOB,"BAR-AOI",BARLOC),",",2),13),!

 +5        QUIT 

 +6       ; ********************************************************************

 +7       ;

TOTAL     ;

 +1       ; Report Total

 +2        WRITE ?64,"============"

 +3        WRITE !?5,"*** REPORT TOTAL"

 +4        WRITE ?62,$JUSTIFY($FNUMBER(^TMP($JOB,"BAR-AOI"),",",2),14)

 +5        QUIT