Routine: BARRNEG2

BARRNEG2 ; IHS/SD/LSL - Print Large Balance Report ;08/20/2008

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

 ; IHS/SD/SDR - V1.8 p6 - DD 4.1.3

 ;       Routine created.  New reports

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

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

NEGB ;EP

 ; Print Negative Balance Report

 S BAR("PG")=0

 S BAR("COL")="W !,""BILL NUMBER"",?14,""DOS"",?22,""DT BILLED"""

 S BAR("COL")=BAR("COL")_",?32,""BILLED AMT"",?45,""PYMTS"",?56,""ADJS"",?68,""BALANCE"""

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

 S BAREQUAL="W ?32,""==============================================="""

 D HDB^BARRPSRB

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

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

 . D EOP^BARUTL(0)

 S BARL=""

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

 D TOTAL

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

LOC ; For each visit location

 W !,"VISIT LOCATION:  ",BARL

 D ALLCAT

 D LOCTOT

ALLCAT ;

 S BARALLC=""

 F  S BARALLC=$O(^TMP($J,"BAR-NEG",BARL,BARALLC)) Q:BARALLC=""  D

 .W !,"ALLOWANCE CATEGORY:  ",BARALLC

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

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

 .D ALLCTOT

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

CLINVIS ; For Clinic / Visit Type Sort

 S BAR2=""

 F  S BAR2=$O(^TMP($J,"BAR-NEG",BARL,BARALLC,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-NEG",BARL,BARALLC,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-NEG",BARL,BARALLC,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-NEG",BARL,BARALLC,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-NEG",BARL,BARALLC,BAR2,BARACT,BAR3P,BARBL))

 . D STNDLINE

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

CVACTOT ;

 ; CV AR Account Total

W !

 X BARDASH

 W !?1,"AR Account Subtotal ($):"

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

 D STNDTOT

W !

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

CVTOT ;

 ; Clinic / Visit type total

 X BARDASH

 I BARY("SORT")="C" W !?5,"Clinic Subtotal ($):"

 E  W !?1,"Visit Type Subtotal ($):"

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

 D STNDTOT

W !

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

STND ;

 ; For not Clinic / Visit Type Sort

 S BARACT=""

 F  S BARACT=$O(^TMP($J,"BAR-NEG",BARL,BARALLC,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-NEG",BARL,BARALLC,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-NEG",BARL,BARALLC,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-NEG",BARL,BARALLC,BARACT,BAR3P,BARBL))

 . D STNDLINE

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

STNDLINE ;

 ; Write Data line

 W !,$P(BARBL,"-")                         ; AR Bill

 W ?12,$$SHDT^BARDUTL($P(BARHOLD,U))         ; DOS Begin

 W ?22,$$SHDT^BARDUTL(BAR3P)                 ; 3P Approval Date

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

 W ?43,$J($FN($P(BARHOLD,U,3),",",2),10)     ; Summary of payments

 W ?54,$J($FN($P(BARHOLD,U,4),",",2),10)     ; Summary of adjustments

 W ?68,$J($FN($P(BARHOLD,U,5),",",2),11)    ; Balance on Bill

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

ACTOT ;

 ; AR Account Total

W !

 X BARDASH

 W !?1,"AR Account Subtotal ($):"

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

 D STNDTOT

W !

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

ALLCTOT ;

 ; Allowance Category total

 X BARDASH

 W !?2,"All. Cat. Subtotal ($):"

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

 D STNDTOT

W !

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

LOCTOT ;

 ; Visit Location total

 X BARDASH

 W !?2,"Visit Loc Subtotal ($):"

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

 D STNDTOT

W !

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

TOTAL ;

 ; Report total

 X BAREQUAL

 W !?7,"Report Total ($):"

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

 D STNDTOT

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

STNDTOT ;

 ; Write total lines

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

 W ?43,$J($FN($P(BARHOLD,U,3),",",2),10)          ; Summary of pymts

 W ?54,$J($FN($P(BARHOLD,U,4),",",2),10)          ; Summary of adjs

 W ?68,$J($FN($P(BARHOLD,U,5),",",2),11)          ; Balance on Bill

BARRNEG2  ; IHS/SD/LSL - Print Large Balance Report ;08/20/2008

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

 +2       ;

 +3       ; IHS/SD/SDR - V1.8 p6 - DD 4.1.3

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

NEGB      ;EP

 +1       ; Print Negative Balance Report

 +2       ;

 +3        SET BAR("PG")=0

 +4        SET BAR("COL")="W !,""BILL NUMBER"",?14,""DOS"",?22,""DT BILLED"""

 +5        SET BAR("COL")=BAR("COL")_",?32,""BILLED AMT"",?45,""PYMTS"",?56,""ADJS"",?68,""BALANCE"""

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

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

 +8       ;

 +9        DO HDB^BARRPSRB

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

               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-NEG",BARL))

               IF BARL=""

                   QUIT

               DO LOC

               IF $GET(BAR("F1"))

                   QUIT

 +16       DO TOTAL

 +17       QUIT

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

LOC       ; For each visit location

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

 +2        DO ALLCAT

 +3        DO LOCTOT

 +4        QUIT

ALLCAT    ;

 +1        SET BARALLC=""

 +2        FOR

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

               IF BARALLC=""

                   QUIT

               Begin DoDot:1

 +3                WRITE !,"ALLOWANCE CATEGORY:  ",BARALLC

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

                       DO CLINVIS

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

                       DO STND

 +6                DO ALLCTOT

               End DoDot:1

 +7        QUIT

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

CLINVIS   ; For Clinic / Visit Type Sort

 +1        SET BAR2=""

 +2        FOR

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

               IF BAR2=""

                   QUIT

               DO CVLOOP

               IF $GET(BAR("F1"))

                   QUIT

 +3        QUIT

 +4       ; ********************************************************************

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-NEG",BARL,BARALLC,BAR2,BARACT))

               IF BARACT=""

                   QUIT

               DO CVACCT

               IF $GET(BAR("F1"))

                   QUIT

 +6        DO CVTOT

 +7        QUIT

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

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-NEG",BARL,BARALLC,BAR2,BARACT,BAR3P))

               IF '+BAR3P

                   QUIT

               DO CVAPPR

               IF $GET(BAR("F1"))

                   QUIT

 +5        DO CVACTOT

 +6        QUIT

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

CVAPPR    ;

 +1       ; For each CV 3P Approval Date

 +2        SET BARBL=""

 +3        FOR

               SET BARBL=$ORDER(^TMP($JOB,"BAR-NEG",BARL,BARALLC,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-NEG",BARL,BARALLC,BAR2,BARACT,BAR3P,BARBL))

 +6                DO STNDLINE

               End DoDot:1

               IF $GET(BAR("F1"))

                   QUIT

 +7        QUIT

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

CVACTOT   ;

 +1       ; CV AR Account Total

 +2        WRITE !

 +3        XECUTE BARDASH

 +4        WRITE !?1,"AR Account Subtotal ($):"

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

 +6        DO STNDTOT

 +7        WRITE !

 +8        QUIT

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

CVTOT     ;

 +1       ; Clinic / Visit type total

 +2        XECUTE BARDASH

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

               WRITE !?5,"Clinic Subtotal ($):"

 +4       IF '$TEST

               WRITE !?1,"Visit Type Subtotal ($):"

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

 +6        DO STNDTOT

 +7        WRITE !

 +8        QUIT

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

STND      ;

 +1       ; For not Clinic / Visit Type Sort

 +2        SET BARACT=""

 +3        FOR

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

               IF BARACT=""

                   QUIT

               DO ACCT

               IF $GET(BAR("F1"))

                   QUIT

 +4        QUIT

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

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-NEG",BARL,BARALLC,BARACT,BAR3P))

               IF '+BAR3P

                   QUIT

               DO APPR

               IF $GET(BAR("F1"))

                   QUIT

 +5        DO ACTOT

 +6        QUIT

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

APPR      ;

 +1       ; For each 3P Approval Date

 +2        SET BARBL=""

 +3        FOR

               SET BARBL=$ORDER(^TMP($JOB,"BAR-NEG",BARL,BARALLC,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-NEG",BARL,BARALLC,BARACT,BAR3P,BARBL))

 +6                DO STNDLINE

               End DoDot:1

               IF $GET(BAR("F1"))

                   QUIT

 +7        QUIT

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

STNDLINE  ;

 +1       ; Write Data line

 +2       ; AR Bill

           WRITE !,$PIECE(BARBL,"-")

 +3       ; DOS Begin

           WRITE ?12,$$SHDT^BARDUTL($PIECE(BARHOLD,U))

 +4       ; 3P Approval Date

           WRITE ?22,$$SHDT^BARDUTL(BAR3P)

 +5       ; Billed Amount

           WRITE ?31,$JUSTIFY($FNUMBER($PIECE(BARHOLD,U,2),",",2),11)

 +6       ; Summary of payments

           WRITE ?43,$JUSTIFY($FNUMBER($PIECE(BARHOLD,U,3),",",2),10)

 +7       ; Summary of adjustments

           WRITE ?54,$JUSTIFY($FNUMBER($PIECE(BARHOLD,U,4),",",2),10)

 +8       ; Balance on Bill

           WRITE ?68,$JUSTIFY($FNUMBER($PIECE(BARHOLD,U,5),",",2),11)

 +9        QUIT

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

ACTOT     ;

 +1       ; AR Account Total

 +2        WRITE !

 +3        XECUTE BARDASH

 +4        WRITE !?1,"AR Account Subtotal ($):"

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

 +6        DO STNDTOT

 +7        WRITE !

 +8        QUIT

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

ALLCTOT   ;

 +1       ; Allowance Category total

 +2        XECUTE BARDASH

 +3        WRITE !?2,"All. Cat. Subtotal ($):"

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

 +5        DO STNDTOT

 +6        WRITE !

 +7        QUIT

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

LOCTOT    ;

 +1       ; Visit Location total

 +2        XECUTE BARDASH

 +3        WRITE !?2,"Visit Loc Subtotal ($):"

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

 +5        DO STNDTOT

 +6        WRITE !

 +7        QUIT

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

TOTAL     ;

 +1       ; Report total

 +2        XECUTE BAREQUAL

 +3        WRITE !?7,"Report Total ($):"

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

 +5        DO STNDTOT

 +6        QUIT

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

STNDTOT   ;

 +1       ; Write total lines

 +2       ; Billed Amount

           WRITE ?31,$JUSTIFY($FNUMBER($PIECE(BARHOLD,U,2),",",2),11)

 +3       ; Summary of pymts

           WRITE ?43,$JUSTIFY($FNUMBER($PIECE(BARHOLD,U,3),",",2),10)

 +4       ; Summary of adjs

           WRITE ?54,$JUSTIFY($FNUMBER($PIECE(BARHOLD,U,4),",",2),10)

 +5       ; Balance on Bill

           WRITE ?68,$JUSTIFY($FNUMBER($PIECE(BARHOLD,U,5),",",2),11)

 +6        QUIT

BARRNEG2.m