Routine: BARRAMR2

BARRAMR2 ; IHS/SD/LSL - Aging management report ;08/20/2008

 ;;1.8;IHS ACCOUNTS RECEIVABLE;**7,23,24**;OCT 26, 2005;Build 69

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

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

 ;     Detail print of Aging management report

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

 ;     Modified to print missing clinics and visit types

 ; IHS/SD/POTT HEAT102270 IGNORE LINE ITEMS WITH BALANCES=0 - BAR1.8*23

 ; IHS/SD/POTT HEAT151319 APPLY HEAT 102270 CHANGE ONLY TO AGING REPORT [2/10/2014]  - BAR1.8*24

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

DETAIL ; EP

 ; Print Detail

 S BAR("COL")="W !,""Patient"",?22,""Bill Number"",?42,""DOS"",?51,""Amount Billed"",?68,""Balance"""

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

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

 D HDB                    ; Page and column header

 S (BAR("CNT1"),BAR("CNT2"),BAR("CNT3"),BAR("CNT"))=0

 S (BAR("BTOT1"),BAR("BTOT2"),BAR("BTOT3"),BAR("BTOT"))=0

 S (BAR("ATOT1"),BAR("ATOT2"),BAR("ATOT3"),BAR("ATOT"))=0

 S BAR("ACCT")=""         ; Initialize account   (3)

 S BAR("L")=""            ; Initialize location  (1)

 S BAR("SORT")=""         ; Initialize sort      (2)

 S BAR("Z")="TMP("_$J_",""BAR-AMR"""

 S BAR="^"_BAR("Z")_")"

 I '$D(@BAR) D  Q         ; No data, message, quit

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

 . D EOP^BARUTL(0)

 ; traverse the temp global...

 F  S BAR=$Q(@BAR) Q:BAR'[BAR("Z")  D  Q:$G(BAR("F1"))

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

 . S BAR("TXT")=$P($P(BAR,",",3,99),"""",2)

 . S BAR("B")=$G(^BARBL(DUZ(2),$P(BAR("TXT"),U,5),0))

 . Q:BAR("B")=""

 . S BAR("B1")=$G(^BARBL(DUZ(2),$P(BAR("TXT"),U,5),1))

 . S BAR("AMT")=$P(BAR("B"),U,13)       ; Bill amount

 . S BAR("BAL")=$P(BAR("B"),U,15)       ; Remaining balance

 . S BAR("DOS")=$P(BAR("B1"),U,2)       ; DOS begin

 . S Y=BAR("DOS") D DD^%DT              ; External format

 . S BAR("DOS")=Y

 . ;;;I +BAR("BAL")=0 QUIT  ; - BAR1.8*23

 . I $G(BAR("HD",0))["Aging" I +BAR("BAL")=0 QUIT  ;P.OTT HEAT151319  - BAR1.8*24

 . I BAR("L")'=$P(BAR("TXT"),U) D

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

 . . I BAR("L")]"" D

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

 . . . D SUB3,SUB2,SUB

 . . . W !

 . . W !?5,"Visit Location: ",$P(BAR("TXT"),U)

 . . S (BAR("SORT"),BAR("ACCT"))=""

 . S BAR("L")=$P(BAR("TXT"),U)

 . I BAR("SORT")'=$P(BAR("TXT"),U,2) D

 . . I BAR("SORT")]"" D

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

 . . . D SUB3,SUB2

 . . . W !

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

 . . . W !?10,"    Clinic: "

 . . . I $P(BAR("TXT"),U,2)=99999 W "NO CLINIC"

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

 . . E  D

 . . . W !?10,"Visit Type: "

 . . . I $P(BAR("TXT"),U,2)=99999 W "NO VISIT TYPE"

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

 . . S BAR("ACCT")=""

 . S BAR("SORT")=$P(BAR("TXT"),U,2)

 . I BAR("ACCT")'=$P(BAR("TXT"),U,3) D

 . . I BAR("ACCT")]"" D

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

 . . . D SUB3

 . . . W !

 . . W !?15,"A/R Account: ",$P(BAR("TXT"),U,3),!

 . S BAR("ACCT")=$P(BAR("TXT"),U,3)

 . W !,$E($P(BAR("TXT"),U,4),1,18)                  ; Patient name

 . W ?20,$P(BAR("B"),U)                             ; A/R Bill

 . W ?38,BAR("DOS")                                 ; DOS Begin

 . W ?51,$J($FN($P(BAR("B"),U,13),",",2),13)        ; Bill Amount

 . W ?65,$J($FN($P(BAR("B"),U,15),",",2),13)        ; Remaining Balance

 . S BAR("CNT")=$G(BAR("CNT"))+1                    ; Total count

 . S BAR("CNT1")=$G(BAR("CNT1"))+1                  ; Count per location

 . S BAR("CNT2")=$G(BAR("CNT2"))+1                  ; Count per sort

 . S BAR("CNT3")=$G(BAR("CNT3"))+1                  ; Count per acct

 . S BAR("ATOT")=$G(BAR("ATOT"))+$P(BAR("B"),U,13)  ; Amount tot

 . S BAR("ATOT1")=$G(BAR("ATOT1"))+$P(BAR("B"),U,13)  ; Amount per loc

 . S BAR("ATOT2")=$G(BAR("ATOT2"))+$P(BAR("B"),U,13)  ; Amount per sort

 . S BAR("ATOT3")=$G(BAR("ATOT3"))+$P(BAR("B"),U,13)  ; Amount per acct

 . S BAR("BTOT")=$G(BAR("BTOT"))+$P(BAR("B"),U,15)  ; Amount tot

 . S BAR("BTOT1")=$G(BAR("BTOT1"))+$P(BAR("B"),U,15)  ; Amount per loc

 . S BAR("BTOT2")=$G(BAR("BTOT2"))+$P(BAR("B"),U,15)  ; Amount per sort

 . S BAR("BTOT3")=$G(BAR("BTOT3"))+$P(BAR("B"),U,15)  ; Amount per acct

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

 D SUB3,SUB2,SUB,TOT

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

HD ; EP

 D PAZ^BARRUTL

 I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S BAR("F1")=1 Q

 ; -------------------------------

HDB ; EP

 ; Page and column header

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

 S BAR("I")=""

 D WHD^BARRHD                   ; Report header

 X BAR("COL")

 S $P(BAR("DASH"),"=",$S($D(BAR(132)):132,1:80))=""

 W !,BAR("DASH")

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

SUB ;

 Q:'BAR("CNT1")

 W !?51,"-------------",?65,"-------------"

 W !,"Visit location"

 W ?20,"Count: ",$J(BAR("CNT1"),4)

 W ?40,"Total:"

 W ?51,$J($FN(BAR("ATOT1"),",",2),13)

 W ?65,$J($FN(BAR("BTOT1"),",",2),13)

 S (BAR("CNT1"),BAR("ATOT1"),BAR("BTOT1"))=0

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

SUB2 ;

 Q:'BAR("CNT2")

 W !?51,"-------------",?65,"-------------"

 I BARY("SORT")="C" W !,"Clinic Type"

 E  W !,"Visit Type"

 W ?20,"Count: ",$J(BAR("CNT2"),4)

 W ?40,"Total:"

 W ?51,$J($FN(BAR("ATOT2"),",",2),13)

 W ?65,$J($FN(BAR("BTOT2"),",",2),13)

 S (BAR("CNT2"),BAR("ATOT2"),BAR("BTOT2"))=0

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

SUB3 ;

 Q:'BAR("CNT3")

 W !?51,"-------------",?65,"-------------"

 W !,"A/R Account"

 W ?20,"Count: ",$J(BAR("CNT3"),4)

 W ?40,"Total:"

 W ?51,$J($FN(BAR("ATOT3"),",",2),13)

 W ?65,$J($FN(BAR("BTOT3"),",",2),13)

 S (BAR("CNT3"),BAR("ATOT3"),BAR("BTOT3"))=0

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

TOT ;

 Q:'BAR("CNT")

 W !?51,"=============",?65,"============="

 W !,"Report Totals"

 W ?20,"Count: ",$J(BAR("CNT"),4)

 W ?40,"Total:"

 W ?51,$J($FN(BAR("ATOT"),",",2),13)

 W ?65,$J($FN(BAR("BTOT"),",",2),13)

 S (BAR("CNT"),BAR("ATOT"),BAR("BTOT"))=0

BARRAMR2  ; IHS/SD/LSL - Aging management report ;08/20/2008

 +1       ;;1.8;IHS ACCOUNTS RECEIVABLE;**7,23,24**;OCT 26, 2005;Build 69

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

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

 +4       ;     Detail 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       ;

 +9       ; IHS/SD/POTT HEAT102270 IGNORE LINE ITEMS WITH BALANCES=0 - BAR1.8*23

 +10      ; IHS/SD/POTT HEAT151319 APPLY HEAT 102270 CHANGE ONLY TO AGING REPORT [2/10/2014]  - BAR1.8*24

 +11       QUIT

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

 +13      ;

DETAIL    ; EP

 +1       ; Print Detail

 +2        SET BAR("COL")="W !,""Patient"",?22,""Bill Number"",?42,""DOS"",?51,""Amount Billed"",?68,""Balance"""

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

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

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

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

 +5       ; Page and column header

           DO HDB

 +6        SET (BAR("CNT1"),BAR("CNT2"),BAR("CNT3"),BAR("CNT"))=0

 +7        SET (BAR("BTOT1"),BAR("BTOT2"),BAR("BTOT3"),BAR("BTOT"))=0

 +8        SET (BAR("ATOT1"),BAR("ATOT2"),BAR("ATOT3"),BAR("ATOT"))=0

 +9       ; Initialize account   (3)

           SET BAR("ACCT")=""

 +10      ; Initialize location  (1)

           SET BAR("L")=""

 +11      ; Initialize sort      (2)

           SET BAR("SORT")=""

 +12       SET BAR("Z")="TMP("_$JOB_",""BAR-AMR"""

 +13       SET BAR="^"_BAR("Z")_")"

 +14      ; No data, message, quit

           IF '$DATA(@BAR)

               Begin DoDot:1

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

 +16               DO EOP^BARUTL(0)

               End DoDot:1

               QUIT

 +17      ; traverse the temp global...

 +18       FOR

               SET BAR=$QUERY(@BAR)

               IF BAR'[BAR("Z")

                   QUIT

               Begin DoDot:1

 +19               IF $Y>(IOSL-5)

                       DO HD

                       IF $GET(BAR("F1"))

                           QUIT

 +20               SET BAR("TXT")=$PIECE($PIECE(BAR,",",3,99),"""",2)

 +21               SET BAR("B")=$GET(^BARBL(DUZ(2),$PIECE(BAR("TXT"),U,5),0))

 +22               IF BAR("B")=""

                       QUIT

 +23               SET BAR("B1")=$GET(^BARBL(DUZ(2),$PIECE(BAR("TXT"),U,5),1))

 +24      ; Bill amount

                   SET BAR("AMT")=$PIECE(BAR("B"),U,13)

 +25      ; Remaining balance

                   SET BAR("BAL")=$PIECE(BAR("B"),U,15)

 +26      ; DOS begin

                   SET BAR("DOS")=$PIECE(BAR("B1"),U,2)

 +27      ; External format

                   SET Y=BAR("DOS")

                   DO DD^%DT

 +28               SET BAR("DOS")=Y

 +29      ;;;I +BAR("BAL")=0 QUIT  ; - BAR1.8*23

 +30      ;P.OTT HEAT151319  - BAR1.8*24

                   IF $GET(BAR("HD",0))["Aging"

                       IF +BAR("BAL")=0

                           QUIT

 +31               IF BAR("L")'=$PIECE(BAR("TXT"),U)

                       Begin DoDot:2

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

                               QUIT

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

                               Begin DoDot:3

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

                                       QUIT

 +35                               DO SUB3

                                   DO SUB2

                                   DO SUB

 +36                               WRITE !

                               End DoDot:3

 +37                       WRITE !?5,"Visit Location: ",$PIECE(BAR("TXT"),U)

 +38                       SET (BAR("SORT"),BAR("ACCT"))=""

                       End DoDot:2

 +39               SET BAR("L")=$PIECE(BAR("TXT"),U)

 +40               IF BAR("SORT")'=$PIECE(BAR("TXT"),U,2)

                       Begin DoDot:2

 +41                       IF BAR("SORT")]""

                               Begin DoDot:3

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

                                       QUIT

 +43                               DO SUB3

                                   DO SUB2

 +44                               WRITE !

                               End DoDot:3

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

                               Begin DoDot:3

 +46                               WRITE !?10,"    Clinic: "

 +47                               IF $PIECE(BAR("TXT"),U,2)=99999

                                       WRITE "NO CLINIC"

 +48                              IF '$TEST

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

                               End DoDot:3

 +49                      IF '$TEST

                               Begin DoDot:3

 +50                               WRITE !?10,"Visit Type: "

 +51                               IF $PIECE(BAR("TXT"),U,2)=99999

                                       WRITE "NO VISIT TYPE"

 +52                              IF '$TEST

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

                               End DoDot:3

 +53                       SET BAR("ACCT")=""

                       End DoDot:2

 +54               SET BAR("SORT")=$PIECE(BAR("TXT"),U,2)

 +55               IF BAR("ACCT")'=$PIECE(BAR("TXT"),U,3)

                       Begin DoDot:2

 +56                       IF BAR("ACCT")]""

                               Begin DoDot:3

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

                                       QUIT

 +58                               DO SUB3

 +59                               WRITE !

                               End DoDot:3

 +60                       WRITE !?15,"A/R Account: ",$PIECE(BAR("TXT"),U,3),!

                       End DoDot:2

 +61               SET BAR("ACCT")=$PIECE(BAR("TXT"),U,3)

 +62      ; Patient name

                   WRITE !,$EXTRACT($PIECE(BAR("TXT"),U,4),1,18)

 +63      ; A/R Bill

                   WRITE ?20,$PIECE(BAR("B"),U)

 +64      ; DOS Begin

                   WRITE ?38,BAR("DOS")

 +65      ; Bill Amount

                   WRITE ?51,$JUSTIFY($FNUMBER($PIECE(BAR("B"),U,13),",",2),13)

 +66      ; Remaining Balance

                   WRITE ?65,$JUSTIFY($FNUMBER($PIECE(BAR("B"),U,15),",",2),13)

 +67      ; Total count

                   SET BAR("CNT")=$GET(BAR("CNT"))+1

 +68      ; Count per location

                   SET BAR("CNT1")=$GET(BAR("CNT1"))+1

 +69      ; Count per sort

                   SET BAR("CNT2")=$GET(BAR("CNT2"))+1

 +70      ; Count per acct

                   SET BAR("CNT3")=$GET(BAR("CNT3"))+1

 +71      ; Amount tot

                   SET BAR("ATOT")=$GET(BAR("ATOT"))+$PIECE(BAR("B"),U,13)

 +72      ; Amount per loc

                   SET BAR("ATOT1")=$GET(BAR("ATOT1"))+$PIECE(BAR("B"),U,13)

 +73      ; Amount per sort

                   SET BAR("ATOT2")=$GET(BAR("ATOT2"))+$PIECE(BAR("B"),U,13)

 +74      ; Amount per acct

                   SET BAR("ATOT3")=$GET(BAR("ATOT3"))+$PIECE(BAR("B"),U,13)

 +75      ; Amount tot

                   SET BAR("BTOT")=$GET(BAR("BTOT"))+$PIECE(BAR("B"),U,15)

 +76      ; Amount per loc

                   SET BAR("BTOT1")=$GET(BAR("BTOT1"))+$PIECE(BAR("B"),U,15)

 +77      ; Amount per sort

                   SET BAR("BTOT2")=$GET(BAR("BTOT2"))+$PIECE(BAR("B"),U,15)

 +78      ; Amount per acct

                   SET BAR("BTOT3")=$GET(BAR("BTOT3"))+$PIECE(BAR("B"),U,15)

               End DoDot:1

               IF $GET(BAR("F1"))

                   QUIT

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

               QUIT

 +80       DO SUB3

           DO SUB2

           DO SUB

           DO TOT

 +81       QUIT

 +82      ; *********************************************************************

 +83      ;

HD        ; EP

 +1        DO PAZ^BARRUTL

 +2        IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)

               SET BAR("F1")=1

               QUIT

 +3       ; -------------------------------

 +4       ;

HDB       ; EP

 +1       ; Page and column header

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

 +3        SET BAR("I")=""

 +4       ; Report header

           DO WHD^BARRHD

 +5        XECUTE BAR("COL")

 +6        SET $PIECE(BAR("DASH"),"=",$SELECT($DATA(BAR(132)):132,1:80))=""

 +7        WRITE !,BAR("DASH")

 +8        QUIT

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

 +10      ;

SUB       ;

 +1        IF 'BAR("CNT1")

               QUIT

 +2        WRITE !?51,"-------------",?65,"-------------"

 +3        WRITE !,"Visit location"

 +4        WRITE ?20,"Count: ",$JUSTIFY(BAR("CNT1"),4)

 +5        WRITE ?40,"Total:"

 +6        WRITE ?51,$JUSTIFY($FNUMBER(BAR("ATOT1"),",",2),13)

 +7        WRITE ?65,$JUSTIFY($FNUMBER(BAR("BTOT1"),",",2),13)

 +8        SET (BAR("CNT1"),BAR("ATOT1"),BAR("BTOT1"))=0

 +9        QUIT

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

 +11      ;

SUB2      ;

 +1        IF 'BAR("CNT2")

               QUIT

 +2        WRITE !?51,"-------------",?65,"-------------"

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

               WRITE !,"Clinic Type"

 +4       IF '$TEST

               WRITE !,"Visit Type"

 +5        WRITE ?20,"Count: ",$JUSTIFY(BAR("CNT2"),4)

 +6        WRITE ?40,"Total:"

 +7        WRITE ?51,$JUSTIFY($FNUMBER(BAR("ATOT2"),",",2),13)

 +8        WRITE ?65,$JUSTIFY($FNUMBER(BAR("BTOT2"),",",2),13)

 +9        SET (BAR("CNT2"),BAR("ATOT2"),BAR("BTOT2"))=0

 +10       QUIT

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

 +12      ;

SUB3      ;

 +1        IF 'BAR("CNT3")

               QUIT

 +2        WRITE !?51,"-------------",?65,"-------------"

 +3        WRITE !,"A/R Account"

 +4        WRITE ?20,"Count: ",$JUSTIFY(BAR("CNT3"),4)

 +5        WRITE ?40,"Total:"

 +6        WRITE ?51,$JUSTIFY($FNUMBER(BAR("ATOT3"),",",2),13)

 +7        WRITE ?65,$JUSTIFY($FNUMBER(BAR("BTOT3"),",",2),13)

 +8        SET (BAR("CNT3"),BAR("ATOT3"),BAR("BTOT3"))=0

 +9        QUIT

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

 +11      ;

TOT       ;

 +1        IF 'BAR("CNT")

               QUIT

 +2        WRITE !?51,"=============",?65,"============="

 +3        WRITE !,"Report Totals"

 +4        WRITE ?20,"Count: ",$JUSTIFY(BAR("CNT"),4)

 +5        WRITE ?40,"Total:"

 +6        WRITE ?51,$JUSTIFY($FNUMBER(BAR("ATOT"),",",2),13)

 +7        WRITE ?65,$JUSTIFY($FNUMBER(BAR("BTOT"),",",2),13)

 +8        SET (BAR("CNT"),BAR("ATOT"),BAR("BTOT"))=0

 +9        QUIT

BARRAMR2.m