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
; ********************************************************************
Q
;
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
Q
; ********************************************************************
LOC ; For each visit location
W !,"VISIT LOCATION: ",BARL
D ALLCAT
D LOCTOT
Q
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
Q
; ********************************************************************
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"))
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-NEG",BARL,BARALLC,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-NEG",BARL,BARALLC,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-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
Q
; ********************************************************************
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 !
Q
; ********************************************************************
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 !
Q
; ********************************************************************
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"))
Q
; ********************************************************************
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
Q
; ********************************************************************
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
Q
; ********************************************************************
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
Q
; ********************************************************************
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 !
Q
; ********************************************************************
ALLCTOT ;
; Allowance Category total
X BARDASH
W !?2,"All. Cat. Subtotal ($):"
S BARHOLD=$G(^TMP($J,"BAR-NEG",BARL,BARALLC))
D STNDTOT
W !
Q
; ********************************************************************
LOCTOT ;
; Visit Location total
X BARDASH
W !?2,"Visit Loc Subtotal ($):"
S BARHOLD=$G(^TMP($J,"BAR-NEG",BARL))
D STNDTOT
W !
Q
; ********************************************************************
TOTAL ;
; Report total
X BAREQUAL
W !?7,"Report Total ($):"
S BARHOLD=$G(^TMP($J,"BAR-NEG"))
D STNDTOT
Q
; ********************************************************************
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
Q
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
