BARRLBL2 ; IHS/SD/LSL - Print Large 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
; ********************************************************************
Q
;
LARGE ;EP
; Print Large Balance Report
;
S BAR("PG")=0
S BAR("COL")="W !,""BILL NUMBER"",?22,""DOS"",?30,""DATE BILLED"""
S BAR("COL")=BAR("COL")_",?43,""DTB"",?50,""BILLED AMT"",?67,""BALANCE"",?76,""AGE"""
S BARDASH="W ?42,""---- ------------- ------------- ----"""
S BAREQUAL="W ?42,""==== ============= ============= ===="""
;
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
Q
; ********************************************************************
;
LOC ;
; For each visit location
W !,"VISIT LOCATION: ",BARL
I $D(BARY("SORT")) D CLINVIS
I '$D(BARY("SORT")) D STND
D LOCTOT
Q
; ********************************************************************
; ********************************************************************
;
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"))
Q
; ********************************************************************
;
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
Q
; ********************************************************************
;
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
Q
; ********************************************************************
;
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
Q
; ********************************************************************
;
CVACTOT ;
; CV AR Account Total
W !
X BARDASH
W !?1,"AR Account Subotal ($) and Average (#):"
S BARHOLD=$G(^TMP($J,"BAR-LBL",BARL,BAR2,BARACT))
D STNDTOT
W !
Q
; ********************************************************************
;
CVTOT ;
; Clinic / Visit type total
X BARDASH
I BARY("SORT")="C" W !?5,"Clinic Subtotal ($) and Average (#):"
E W !?1,"Visit Type Subtotal ($) and Average (#):"
S BARHOLD=$G(^TMP($J,"BAR-LBL",BARL,BAR2))
D STNDTOT
W !
Q
; ********************************************************************
; ********************************************************************
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"))
Q
; ********************************************************************
;
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
Q
; ********************************************************************
;
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
Q
; ********************************************************************
;
STNDLINE ;
; Write Data line
W !,$E(BARBL,1,18) ; AR Bill
W ?19,$$SDT^BARDUTL($P(BARHOLD,U)) ; DOS Begin
W ?31,$$SDT^BARDUTL(BAR3P) ; 3P Approval Date
W ?42,$J($P(BARHOLD,U,2),4) ; Days since DOS Begin
W ?47,$J($FN($P(BARHOLD,U,3),",",2),13) ; Billed Amount
W ?61,$J($FN($P(BARHOLD,U,4),",",2),13) ; Balance on Bill
W ?75,$J($P(BARHOLD,U,5),4) ; Days since 3P Approved
Q
; ********************************************************************
;
ACTOT ;
; AR Account Total
W !
X BARDASH
W !?1,"AR Account Subotal ($) and Average (#):"
S BARHOLD=$G(^TMP($J,"BAR-LBL",BARL,BARACT))
D STNDTOT
W !
Q
; ********************************************************************
;
LOCTOT ;
; Visit Location total
X BARDASH
W !?2,"Visit Loc Subotal ($) and Average (#):"
S BARHOLD=$G(^TMP($J,"BAR-LBL",BARL))
D STNDTOT
W !
Q
; ********************************************************************
;
TOTAL ;
; Report total
X BAREQUAL
W !?7,"Report Total ($) and Average (#):"
S BARHOLD=$G(^TMP($J,"BAR-LBL"))
D STNDTOT
Q
; ********************************************************************
;
STNDTOT ;
; Write total lines
W ?42,$J(($P(BARHOLD,U)/$P(BARHOLD,U,5)),4,0) ; Days since DOS Begin
W ?47,$J($FN($P(BARHOLD,U,2),",",2),13) ; Billed Amount
W ?61,$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
Q
BARRLBL2 ; IHS/SD/LSL - Print Large 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 ;
LARGE ;EP
+1 ; Print Large Balance Report
+2 ;
+3 SET BAR("PG")=0
+4 SET BAR("COL")="W !,""BILL NUMBER"",?22,""DOS"",?30,""DATE BILLED"""
+5 SET BAR("COL")=BAR("COL")_",?43,""DTB"",?50,""BILLED AMT"",?67,""BALANCE"",?76,""AGE"""
+6 SET BARDASH="W ?42,""---- ------------- ------------- ----"""
+7 SET BAREQUAL="W ?42,""==== ============= ============= ===="""
+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 !?1,"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 !?5,"Clinic Subtotal ($) and Average (#):"
+4 IF '$TEST
WRITE !?1,"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 ?19,$$SDT^BARDUTL($PIECE(BARHOLD,U))
+4 ; 3P Approval Date
WRITE ?31,$$SDT^BARDUTL(BAR3P)
+5 ; Days since DOS Begin
WRITE ?42,$JUSTIFY($PIECE(BARHOLD,U,2),4)
+6 ; Billed Amount
WRITE ?47,$JUSTIFY($FNUMBER($PIECE(BARHOLD,U,3),",",2),13)
+7 ; Balance on Bill
WRITE ?61,$JUSTIFY($FNUMBER($PIECE(BARHOLD,U,4),",",2),13)
+8 ; Days since 3P Approved
WRITE ?75,$JUSTIFY($PIECE(BARHOLD,U,5),4)
+9 QUIT
+10 ; ********************************************************************
+11 ;
ACTOT ;
+1 ; AR Account Total
+2 WRITE !
+3 XECUTE BARDASH
+4 WRITE !?1,"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 !?2,"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 !?7,"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 ; Days since DOS Begin
WRITE ?42,$JUSTIFY(($PIECE(BARHOLD,U)/$PIECE(BARHOLD,U,5)),4,0)
+3 ; Billed Amount
WRITE ?47,$JUSTIFY($FNUMBER($PIECE(BARHOLD,U,2),",",2),13)
+4 ; Balance on Bill
WRITE ?61,$JUSTIFY($FNUMBER($PIECE(BARHOLD,U,3),",",2),13)
+5 ; Days since 3P Approve
WRITE ?75,$JUSTIFY(($PIECE(BARHOLD,U,4)/$PIECE(BARHOLD,U,5)),4,0)
+6 QUIT
