BARRAMR3.m

BARRAMR3 ; IHS/SD/LSL - Aging management report ;

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

 ;

 ; IHS/ASDS/LSL - 09/26/00 - Routine created

 ;     Summary print of Aging management report

 ;

 ; IHS/SD/LSL - 07/08/02 - V1.6 Patch 2

 ;     Modified to print missing clinics and visit types

 Q

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

 ;

SUMM ; EP

 S BAR("COL")="W !,""A/R Account"",?32,""Bill Total"",?50,""Amount Billed"",?70,""Balance"""

 S:BAR("HD",0)["Bills" BAR("HD",0)="SUMMARY Bills"_$P(BAR("HD",0),"Bills",2,99)

 S:BAR("HD",0)["Aging" BAR("HD",0)="SUMMARY Aging"_$P(BAR("HD",0),"Aging",2,99)

 D HDB^BARRAMR2

 S (BAR("CNT"),BAR("AMT"),BAR("BAL"))=0

 I '$D(BAR("ST")) D  Q

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

 . D EOP^BARUTL(0)

 S (BAR("TCNT"),BAR("TAMT"),BAR("TBAL"))=0

 S (BAR(1),BAR("O1"),BAR("O2"))=""

 F  S BAR(1)=$O(BAR("ST",BAR(1))) Q:BAR(1)=""!($G(BAR("F1")))  D

 . I BAR(1)'=BAR("O1") D HD1

 . S BAR(2)=""

 . F  S BAR(2)=$O(BAR("ST",BAR(1),BAR(2))) Q:BAR(2)=""!($G(BAR("F1")))  D

 . . I BAR(2)'=BAR("O2") D HD2

 . . S BAR(3)=""

 . . F  S BAR(3)=$O(BAR("ST",BAR(1),BAR(2),BAR(3))) Q:BAR(3)=""!($G(BAR("F1")))  D

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

 . . . S BAR("CNT")=$P(BAR("ST",BAR(1),BAR(2),BAR(3)),U)

 . . . S BAR("AMT")=$P(BAR("ST",BAR(1),BAR(2),BAR(3)),U,2)

 . . . S BAR("BAL")=$P(BAR("ST",BAR(1),BAR(2),BAR(3)),U,3)

 . . . W !,$E(BAR(3),1,30)                     ; A/R Account

 . . . W ?35,$J(BAR("CNT"),4)                ; Bill count

 . . . W ?50,$J($FN(BAR("AMT"),",",2),13)    ; Amt billed

 . . . W ?65,$J($FN(BAR("BAL"),",",2),13)    ; Balance

 . . . S BAR("CNT1")=BAR("CNT1")+BAR("CNT")  ; Count per loc

 . . . S BAR("AMT1")=BAR("AMT1")+BAR("AMT")  ; Amt per loc

 . . . S BAR("BAL1")=BAR("BAL1")+BAR("BAL")  ; Balance per loc

 . . . S BAR("CNT2")=BAR("CNT2")+BAR("CNT")  ; Count per sort

 . . . S BAR("AMT2")=BAR("AMT2")+BAR("AMT")  ; Amt per sort

 . . . S BAR("BAL2")=BAR("BAL2")+BAR("BAL")  ; Balance per sort

 . . . S BAR("TCNT")=BAR("TCNT")+BAR("CNT")  ; Grand Count

 . . . S BAR("TAMT")=BAR("TAMT")+BAR("AMT")  ; Grand Amt

 . . . S BAR("TBAL")=BAR("TBAL")+BAR("BAL")  ; Grand Balance

 . . Q:$G(BAR("F1"))

 . . W !?35,"-----",?50,"-------------",?65,"-------------"

 . . I BARY("SORT")="C" W !,"Clinic type subtotal"

 . . E  W !," Visit type subtotal"

 . . W ?35,$J(BAR("CNT2"),4)                 ; Bill count

 . . W ?50,$J($FN(BAR("AMT2"),",",2),13)     ; Amt billed

 . . W ?65,$J($FN(BAR("BAL2"),",",2),13)     ; Balance

 . Q:$G(BAR("F1"))

 . W !?35,"-----",?50,"-------------",?65,"-------------"

 . W !,"Visit location total"

 . W ?35,$J(BAR("CNT1"),4)                  ; Bill count

 . W ?50,$J($FN(BAR("AMT1"),",",2),13)       ; Amt billed

 . W ?65,$J($FN(BAR("BAL1"),",",2),13)       ; Balance

 Q:$G(BAR("F1"))

 W !?35,"=====",?50,"=============",?65,"============="

 W !,"*** REPORT TOTAL ***"

 W ?35,$J(BAR("TCNT"),4)                   ; Bill count

 W ?50,$J($FN(BAR("TAMT"),",",2),13)       ; Amt billed

 W ?65,$J($FN(BAR("TBAL"),",",2),13)       ; Balance

 Q

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

 ;

HD1 ;     

 W !!?5,"Visit Location: ",BAR(1)

 S BAR("O1")=BAR(1)

 S (BAR("CNT1"),BAR("AMT1"),BAR("BAL1"))=0

 Q

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

 ;

HD2 ;

 W !!?10

 I BARY("SORT")="C" D

 . W "Clinic: "

 . I BAR(2)=99999 W "NO CLINIC"

 . E  W $P(^DIC(40.7,BAR(2),0),U)

 I BARY("SORT")="V" D

 . W "Visit Type: "

 . I BAR(2)=99999 W "NO VISIT TYPE"

 . E  W $P(^ABMDVTYP(BAR(2),0),U)

 W !

 S BAR("O2")=BAR(2)

 S (BAR("CNT2"),BAR("AMT2"),BAR("BAL2"))=0

 Q

BARRAMR3  ; IHS/SD/LSL - Aging management report ;

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

 +2       ;

 +3       ; IHS/ASDS/LSL - 09/26/00 - Routine created

 +4       ;     Summary print of Aging management report

 +5       ;

 +6       ; IHS/SD/LSL - 07/08/02 - V1.6 Patch 2

 +7       ;     Modified to print missing clinics and visit types

 +8        QUIT 

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

 +10      ;

SUMM      ; EP

 +1        SET BAR("COL")="W !,""A/R Account"",?32,""Bill Total"",?50,""Amount Billed"",?70,""Balance"""

 +2        IF BAR("HD",0)["Bills"

               SET BAR("HD",0)="SUMMARY Bills"_$PIECE(BAR("HD",0),"Bills",2,99)

 +3        IF BAR("HD",0)["Aging"

               SET BAR("HD",0)="SUMMARY Aging"_$PIECE(BAR("HD",0),"Aging",2,99)

 +4        DO HDB^BARRAMR2

 +5        SET (BAR("CNT"),BAR("AMT"),BAR("BAL"))=0

 +6        IF '$DATA(BAR("ST"))

               Begin DoDot:1

 +7                WRITE !!!,"*** NO DATA TO PRINT ***"

 +8                DO EOP^BARUTL(0)

               End DoDot:1

               QUIT 

 +9        SET (BAR("TCNT"),BAR("TAMT"),BAR("TBAL"))=0

 +10       SET (BAR(1),BAR("O1"),BAR("O2"))=""

 +11       FOR 

               SET BAR(1)=$ORDER(BAR("ST",BAR(1)))

               IF BAR(1)=""!($GET(BAR("F1")))

                   QUIT 

               Begin DoDot:1

 +12               IF BAR(1)'=BAR("O1")

                       DO HD1

 +13               SET BAR(2)=""

 +14               FOR 

                       SET BAR(2)=$ORDER(BAR("ST",BAR(1),BAR(2)))

                       IF BAR(2)=""!($GET(BAR("F1")))

                           QUIT 

                       Begin DoDot:2

 +15                       IF BAR(2)'=BAR("O2")

                               DO HD2

 +16                       SET BAR(3)=""

 +17                       FOR 

                               SET BAR(3)=$ORDER(BAR("ST",BAR(1),BAR(2),BAR(3)))

                               IF BAR(3)=""!($GET(BAR("F1")))

                                   QUIT 

                               Begin DoDot:3

 +18                               IF $Y>(IOSL-5)

                                       DO HD^BARRAMR2

                                       IF $GET(BAR("F1"))

                                           QUIT 

 +19                               SET BAR("CNT")=$PIECE(BAR("ST",BAR(1),BAR(2),BAR(3)),U)

 +20                               SET BAR("AMT")=$PIECE(BAR("ST",BAR(1),BAR(2),BAR(3)),U,2)

 +21                               SET BAR("BAL")=$PIECE(BAR("ST",BAR(1),BAR(2),BAR(3)),U,3)

 +22      ; A/R Account

                                   WRITE !,$EXTRACT(BAR(3),1,30)

 +23      ; Bill count

                                   WRITE ?35,$JUSTIFY(BAR("CNT"),4)

 +24      ; Amt billed

                                   WRITE ?50,$JUSTIFY($FNUMBER(BAR("AMT"),",",2),13)

 +25      ; Balance

                                   WRITE ?65,$JUSTIFY($FNUMBER(BAR("BAL"),",",2),13)

 +26      ; Count per loc

                                   SET BAR("CNT1")=BAR("CNT1")+BAR("CNT")

 +27      ; Amt per loc

                                   SET BAR("AMT1")=BAR("AMT1")+BAR("AMT")

 +28      ; Balance per loc

                                   SET BAR("BAL1")=BAR("BAL1")+BAR("BAL")

 +29      ; Count per sort

                                   SET BAR("CNT2")=BAR("CNT2")+BAR("CNT")

 +30      ; Amt per sort

                                   SET BAR("AMT2")=BAR("AMT2")+BAR("AMT")

 +31      ; Balance per sort

                                   SET BAR("BAL2")=BAR("BAL2")+BAR("BAL")

 +32      ; Grand Count

                                   SET BAR("TCNT")=BAR("TCNT")+BAR("CNT")

 +33      ; Grand Amt

                                   SET BAR("TAMT")=BAR("TAMT")+BAR("AMT")

 +34      ; Grand Balance

                                   SET BAR("TBAL")=BAR("TBAL")+BAR("BAL")

                               End DoDot:3

 +35                       IF $GET(BAR("F1"))

                               QUIT 

 +36                       WRITE !?35,"-----",?50,"-------------",?65,"-------------"

 +37                       IF BARY("SORT")="C"

                               WRITE !,"Clinic type subtotal"

 +38                      IF '$TEST

                               WRITE !," Visit type subtotal"

 +39      ; Bill count

                           WRITE ?35,$JUSTIFY(BAR("CNT2"),4)

 +40      ; Amt billed

                           WRITE ?50,$JUSTIFY($FNUMBER(BAR("AMT2"),",",2),13)

 +41      ; Balance

                           WRITE ?65,$JUSTIFY($FNUMBER(BAR("BAL2"),",",2),13)

                       End DoDot:2

 +42               IF $GET(BAR("F1"))

                       QUIT 

 +43               WRITE !?35,"-----",?50,"-------------",?65,"-------------"

 +44               WRITE !,"Visit location total"

 +45      ; Bill count

                   WRITE ?35,$JUSTIFY(BAR("CNT1"),4)

 +46      ; Amt billed

                   WRITE ?50,$JUSTIFY($FNUMBER(BAR("AMT1"),",",2),13)

 +47      ; Balance

                   WRITE ?65,$JUSTIFY($FNUMBER(BAR("BAL1"),",",2),13)

               End DoDot:1

 +48       IF $GET(BAR("F1"))

               QUIT 

 +49       WRITE !?35,"=====",?50,"=============",?65,"============="

 +50       WRITE !,"*** REPORT TOTAL ***"

 +51      ; Bill count

           WRITE ?35,$JUSTIFY(BAR("TCNT"),4)

 +52      ; Amt billed

           WRITE ?50,$JUSTIFY($FNUMBER(BAR("TAMT"),",",2),13)

 +53      ; Balance

           WRITE ?65,$JUSTIFY($FNUMBER(BAR("TBAL"),",",2),13)

 +54       QUIT 

 +55      ; *********************************************************************

 +56      ;

HD1       ;     

 +1        WRITE !!?5,"Visit Location: ",BAR(1)

 +2        SET BAR("O1")=BAR(1)

 +3        SET (BAR("CNT1"),BAR("AMT1"),BAR("BAL1"))=0

 +4        QUIT 

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

 +6       ;

HD2       ;

 +1        WRITE !!?10

 +2        IF BARY("SORT")="C"

               Begin DoDot:1

 +3                WRITE "Clinic: "

 +4                IF BAR(2)=99999

                       WRITE "NO CLINIC"

 +5               IF '$TEST

                       WRITE $PIECE(^DIC(40.7,BAR(2),0),U)

               End DoDot:1

 +6        IF BARY("SORT")="V"

               Begin DoDot:1

 +7                WRITE "Visit Type: "

 +8                IF BAR(2)=99999

                       WRITE "NO VISIT TYPE"

 +9               IF '$TEST

                       WRITE $PIECE(^ABMDVTYP(BAR(2),0),U)

               End DoDot:1

 +10       WRITE !

 +11       SET BAR("O2")=BAR(2)

 +12       SET (BAR("CNT2"),BAR("AMT2"),BAR("BAL2"))=0

 +13       QUIT