Routine: BARRLBL3

BARRLBL3 ; IHS/SD/LSL - Print Small Balance Report ;08/20/2008

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

 ; IHS/SD/LSL - 04/04/2003 - Version 1.8

 ;       Routine created.  New reports

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

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

SMALL ;EP

 ; Print Small Balance Report

 S BAR("PG")=0

 S BAR("COL")="W !,""BILL NUMBER"",?23,""DOS"",?32,""DATE BILLED"""

 S BAR("COL")=BAR("COL")_",?48,""BILLED AMT"",?66,""BALANCE"",?75,""AGE"""

 S BARDASH="W ?45,""-------------  -------------  ----"""

 S BAREQUAL="W ?45,""=============  =============  ===="""

 D HDB^BARRPSRB

 I '$D(^TMP($J,"BAR-LBL")) D  Q

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

 . D EOP^BARUTL(0)

 S BARL=""

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

 D TOTAL

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

LOC ;

 ; For each visit location

 W !,"VISIT LOCATION:  ",BARL

 I $D(BARY("SORT")) D CLINVIS

 I '$D(BARY("SORT")) D STND

 D LOCTOT

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

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

CLINVIS ;

 ; For Clinic / Visit Type Sort

 S BAR2=""

 F  S BAR2=$O(^TMP($J,"BAR-LBL",BARL,BAR2)) Q:BAR2=""  D CVLOOP  Q:$G(BAR("F1"))

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

CVLOOP ;

 ; For Each Clinic / Visit type

 I BARY("SORT")="C" W !?3,"CLINIC:  ",BAR2

 E  W !?3,"VISIT TYPE:  ",BAR2

 S BARACT=""

 F  S BARACT=$O(^TMP($J,"BAR-LBL",BARL,BAR2,BARACT)) Q:BARACT=""  D CVACCT  Q:$G(BAR("F1"))

 D CVTOT

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

CVACCT ;

 ; For Each CV AR Account

 W !?6,"A/R ACCOUNT:  ",BARACT,!

 S BAR3P=0

 F  S BAR3P=$O(^TMP($J,"BAR-LBL",BARL,BAR2,BARACT,BAR3P)) Q:'+BAR3P  D CVAPPR  Q:$G(BAR("F1"))

 D CVACTOT

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

CVAPPR ;

 ; For each CV 3P Approval Date

 S BARBL=""

 F  S BARBL=$O(^TMP($J,"BAR-LBL",BARL,BAR2,BARACT,BAR3P,BARBL)) Q:BARBL=""  D  Q:$G(BAR("F1"))

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

 . S BARHOLD=$G(^TMP($J,"BAR-LBL",BARL,BAR2,BARACT,BAR3P,BARBL))

 . D STNDLINE

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

CVACTOT ;

 ; CV AR Account Total

W !

 X BARDASH

 W !?6,"AR Account Subotal ($) and Average (#):"

 S BARHOLD=$G(^TMP($J,"BAR-LBL",BARL,BAR2,BARACT))

 D STNDTOT

W !

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

CVTOT ;

 ; Clinic / Visit type total

 X BARDASH

 I BARY("SORT")="C" W !?9,"Clinic Subtotal ($) and Average (#):"

 E  W !?5,"Visit Type Subtotal ($) and Average (#):"

 S BARHOLD=$G(^TMP($J,"BAR-LBL",BARL,BAR2))

 D STNDTOT

W !

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

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

STND ;

 ; For not Clinic / Visit Type Sort

 S BARACT=""

 F  S BARACT=$O(^TMP($J,"BAR-LBL",BARL,BARACT)) Q:BARACT=""  D ACCT  Q:$G(BAR("F1"))

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

ACCT ;

 ; For each AR Account

 W !?3,"A/R ACCOUNT:  ",BARACT,!

 S BAR3P=0

 F  S BAR3P=$O(^TMP($J,"BAR-LBL",BARL,BARACT,BAR3P)) Q:'+BAR3P  D APPR  Q:$G(BAR("F1"))

 D ACTOT

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

APPR ;

 ; For each 3P Approval Date

 S BARBL=""

 F  S BARBL=$O(^TMP($J,"BAR-LBL",BARL,BARACT,BAR3P,BARBL)) Q:BARBL=""  D  Q:$G(BAR("F1"))

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

 . S BARHOLD=$G(^TMP($J,"BAR-LBL",BARL,BARACT,BAR3P,BARBL))

 . D STNDLINE

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

STNDLINE ;

 ; Write Data line

 W !,$E(BARBL,1,18)                         ; AR Bill

 W ?20,$$SDT^BARDUTL($P(BARHOLD,U))         ; DOS Begin

 W ?33,$$SDT^BARDUTL(BAR3P)                 ; 3P Approval Date

 W ?45,$J($FN($P(BARHOLD,U,3),",",2),13)    ; Billed Amount

 W ?60,$J($FN($P(BARHOLD,U,4),",",2),13)    ; Balance on Bill

 W ?75,$J($P(BARHOLD,U,5),4)                ; Days since 3P Approved

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

ACTOT ;

 ; AR Account Total

W !

 X BARDASH

 W !?6,"AR Account Subotal ($) and Average (#):"

 S BARHOLD=$G(^TMP($J,"BAR-LBL",BARL,BARACT))

 D STNDTOT

W !

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

LOCTOT ;

 ; Visit Location total

 X BARDASH

 W !?7,"Visit Loc Subotal ($) and Average (#):"

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

 D STNDTOT

W !

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

TOTAL ;

 ; Report total

 X BAREQUAL

 W !?12,"Report Total ($) and Average (#):"

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

 D STNDTOT

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

STNDTOT ;

 ; Write total lines

 W ?45,$J($FN($P(BARHOLD,U,2),",",2),13)        ; Billed Amount

 W ?60,$J($FN($P(BARHOLD,U,3),",",2),13)        ; Balance on Bill

 W ?75,$J(($P(BARHOLD,U,4)/$P(BARHOLD,U,5)),4,0)  ; Days since 3P Approve

BARRLBL3  ; IHS/SD/LSL - Print Small Balance Report ;08/20/2008

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

 +2       ;

 +3       ; IHS/SD/LSL - 04/04/2003 - Version 1.8

 +4       ;       Routine created.  New reports

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

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

 +7        QUIT

 +8       ;

SMALL     ;EP

 +1       ; Print Small Balance Report

 +2       ;

 +3        SET BAR("PG")=0

 +4        SET BAR("COL")="W !,""BILL NUMBER"",?23,""DOS"",?32,""DATE BILLED"""

 +5        SET BAR("COL")=BAR("COL")_",?48,""BILLED AMT"",?66,""BALANCE"",?75,""AGE"""

 +6        SET BARDASH="W ?45,""-------------  -------------  ----"""

 +7        SET BAREQUAL="W ?45,""=============  =============  ===="""

 +8       ;

 +9        DO HDB^BARRPSRB

 +10       IF '$DATA(^TMP($JOB,"BAR-LBL"))

               Begin DoDot:1

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

 +12               DO EOP^BARUTL(0)

               End DoDot:1

               QUIT

 +13      ;

 +14       SET BARL=""

 +15       FOR

               SET BARL=$ORDER(^TMP($JOB,"BAR-LBL",BARL))

               IF BARL=""

                   QUIT

               DO LOC

               IF $GET(BAR("F1"))

                   QUIT

 +16       DO TOTAL

 +17       QUIT

 +18      ; ********************************************************************

 +19      ;

LOC       ;

 +1       ; For each visit location

 +2        WRITE !,"VISIT LOCATION:  ",BARL

 +3        IF $DATA(BARY("SORT"))

               DO CLINVIS

 +4        IF '$DATA(BARY("SORT"))

               DO STND

 +5        DO LOCTOT

 +6        QUIT

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

 +8       ; ********************************************************************

 +9       ;

CLINVIS   ;

 +1       ; For Clinic / Visit Type Sort

 +2        SET BAR2=""

 +3        FOR

               SET BAR2=$ORDER(^TMP($JOB,"BAR-LBL",BARL,BAR2))

               IF BAR2=""

                   QUIT

               DO CVLOOP

               IF $GET(BAR("F1"))

                   QUIT

 +4        QUIT

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

 +6       ;

CVLOOP    ;

 +1       ; For Each Clinic / Visit type

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

               WRITE !?3,"CLINIC:  ",BAR2

 +3       IF '$TEST

               WRITE !?3,"VISIT TYPE:  ",BAR2

 +4        SET BARACT=""

 +5        FOR

               SET BARACT=$ORDER(^TMP($JOB,"BAR-LBL",BARL,BAR2,BARACT))

               IF BARACT=""

                   QUIT

               DO CVACCT

               IF $GET(BAR("F1"))

                   QUIT

 +6        DO CVTOT

 +7        QUIT

 +8       ; ********************************************************************

 +9       ;

CVACCT    ;

 +1       ; For Each CV AR Account

 +2        WRITE !?6,"A/R ACCOUNT:  ",BARACT,!

 +3        SET BAR3P=0

 +4        FOR

               SET BAR3P=$ORDER(^TMP($JOB,"BAR-LBL",BARL,BAR2,BARACT,BAR3P))

               IF '+BAR3P

                   QUIT

               DO CVAPPR

               IF $GET(BAR("F1"))

                   QUIT

 +5        DO CVACTOT

 +6        QUIT

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

 +8       ;

CVAPPR    ;

 +1       ; For each CV 3P Approval Date

 +2        SET BARBL=""

 +3        FOR

               SET BARBL=$ORDER(^TMP($JOB,"BAR-LBL",BARL,BAR2,BARACT,BAR3P,BARBL))

               IF BARBL=""

                   QUIT

               Begin DoDot:1

 +4                IF $Y>(IOSL-5)

                       DO HD^BARRPSRB

                       IF $GET(BAR("F1"))

                           QUIT

 +5                SET BARHOLD=$GET(^TMP($JOB,"BAR-LBL",BARL,BAR2,BARACT,BAR3P,BARBL))

 +6                DO STNDLINE

               End DoDot:1

               IF $GET(BAR("F1"))

                   QUIT

 +7        QUIT

 +8       ; ********************************************************************

 +9       ;

CVACTOT   ;

 +1       ; CV AR Account Total

 +2        WRITE !

 +3        XECUTE BARDASH

 +4        WRITE !?6,"AR Account Subotal ($) and Average (#):"

 +5        SET BARHOLD=$GET(^TMP($JOB,"BAR-LBL",BARL,BAR2,BARACT))

 +6        DO STNDTOT

 +7        WRITE !

 +8        QUIT

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

 +10      ;

CVTOT     ;

 +1       ; Clinic / Visit type total

 +2        XECUTE BARDASH

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

               WRITE !?9,"Clinic Subtotal ($) and Average (#):"

 +4       IF '$TEST

               WRITE !?5,"Visit Type Subtotal ($) and Average (#):"

 +5        SET BARHOLD=$GET(^TMP($JOB,"BAR-LBL",BARL,BAR2))

 +6        DO STNDTOT

 +7        WRITE !

 +8        QUIT

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

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

STND      ;

 +1       ; For not Clinic / Visit Type Sort

 +2        SET BARACT=""

 +3        FOR

               SET BARACT=$ORDER(^TMP($JOB,"BAR-LBL",BARL,BARACT))

               IF BARACT=""

                   QUIT

               DO ACCT

               IF $GET(BAR("F1"))

                   QUIT

 +4        QUIT

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

 +6       ;

ACCT      ;

 +1       ; For each AR Account

 +2        WRITE !?3,"A/R ACCOUNT:  ",BARACT,!

 +3        SET BAR3P=0

 +4        FOR

               SET BAR3P=$ORDER(^TMP($JOB,"BAR-LBL",BARL,BARACT,BAR3P))

               IF '+BAR3P

                   QUIT

               DO APPR

               IF $GET(BAR("F1"))

                   QUIT

 +5        DO ACTOT

 +6        QUIT

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

 +8       ;

APPR      ;

 +1       ; For each 3P Approval Date

 +2        SET BARBL=""

 +3        FOR

               SET BARBL=$ORDER(^TMP($JOB,"BAR-LBL",BARL,BARACT,BAR3P,BARBL))

               IF BARBL=""

                   QUIT

               Begin DoDot:1

 +4                IF $Y>(IOSL-5)

                       DO HD^BARRPSRB

                       IF $GET(BAR("F1"))

                           QUIT

 +5                SET BARHOLD=$GET(^TMP($JOB,"BAR-LBL",BARL,BARACT,BAR3P,BARBL))

 +6                DO STNDLINE

               End DoDot:1

               IF $GET(BAR("F1"))

                   QUIT

 +7        QUIT

 +8       ; ********************************************************************

 +9       ;

STNDLINE  ;

 +1       ; Write Data line

 +2       ; AR Bill

           WRITE !,$EXTRACT(BARBL,1,18)

 +3       ; DOS Begin

           WRITE ?20,$$SDT^BARDUTL($PIECE(BARHOLD,U))

 +4       ; 3P Approval Date

           WRITE ?33,$$SDT^BARDUTL(BAR3P)

 +5       ; Billed Amount

           WRITE ?45,$JUSTIFY($FNUMBER($PIECE(BARHOLD,U,3),",",2),13)

 +6       ; Balance on Bill

           WRITE ?60,$JUSTIFY($FNUMBER($PIECE(BARHOLD,U,4),",",2),13)

 +7       ; Days since 3P Approved

           WRITE ?75,$JUSTIFY($PIECE(BARHOLD,U,5),4)

 +8        QUIT

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

 +10      ;

ACTOT     ;

 +1       ; AR Account Total

 +2        WRITE !

 +3        XECUTE BARDASH

 +4        WRITE !?6,"AR Account Subotal ($) and Average (#):"

 +5        SET BARHOLD=$GET(^TMP($JOB,"BAR-LBL",BARL,BARACT))

 +6        DO STNDTOT

 +7        WRITE !

 +8        QUIT

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

 +10      ;

LOCTOT    ;

 +1       ; Visit Location total

 +2        XECUTE BARDASH

 +3        WRITE !?7,"Visit Loc Subotal ($) and Average (#):"

 +4        SET BARHOLD=$GET(^TMP($JOB,"BAR-LBL",BARL))

 +5        DO STNDTOT

 +6        WRITE !

 +7        QUIT

 +8       ; ********************************************************************

 +9       ;

TOTAL     ;

 +1       ; Report total

 +2        XECUTE BAREQUAL

 +3        WRITE !?12,"Report Total ($) and Average (#):"

 +4        SET BARHOLD=$GET(^TMP($JOB,"BAR-LBL"))

 +5        DO STNDTOT

 +6        QUIT

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

 +8       ;

STNDTOT   ;

 +1       ; Write total lines

 +2       ; Billed Amount

           WRITE ?45,$JUSTIFY($FNUMBER($PIECE(BARHOLD,U,2),",",2),13)

 +3       ; Balance on Bill

           WRITE ?60,$JUSTIFY($FNUMBER($PIECE(BARHOLD,U,3),",",2),13)

 +4       ; Days since 3P Approve

           WRITE ?75,$JUSTIFY(($PIECE(BARHOLD,U,4)/$PIECE(BARHOLD,U,5)),4,0)

 +5        QUIT

BARRLBL3.m