BARRTAR2 ; IHS/SD/LSL - Transaction report ;08/20/2008
;;1.8;IHS ACCOUNTS RECEIVABLE;**1,7**;MAR 27,2007
; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892
; IHS/ASDS/LSL - 10/05/00 - Routine created
; Detail print of Transaction report
;
; IHS/SD/LSL - 07/10/02 - V1.6 Patch 2
; Modified to print missing clinics and visit types
;
; IHS/SD/LSL - 10/24/02 - V1.7 - PAB-1002-90130
; Modified to accomodate DUZ(2) subscript
;
; IHS/SD/RTL - 5/23/05 - V1.8 Patch 1 - IM17362
; TAR report bombing - missing collection batch
;
Q
; *********************************************************************
;
DETAIL ; EP
; Print Detail
S BAR("COL")="W !,""Bill Number"",?15,""PAY-AMT"",?26,""PRV-CRD"",?37,""REFUND"",?48,""PAYMENT"",?59,""BILL AMT"",?70,""ADJUSTMENT"""
S BAR("HD",0)="DETAIL Transaction"_$P(BAR("HD",0),"Transaction",2,99)
D HDB ; Page and column header
F I=0:1:5 D ; Initialize totals
. S Y=1
. F X="PATOT","PCTOT","RTOT","PTOT","BTOT","ATOT" D
. . S Y=Y+1
. . S BARV=X_I
. . S BARV2="BAR("""_BARV_""")"
. . S @BARV2=0
K I,Y,X
S BARDASH=" ---------- ---------- ---------- ---------- ---------- ----------"
S BAREQUAL=" ========== ========== ========== ========== ========== =========="
S BAR("AR")="" ; Initialize A/R Clerk (1)
S BAR("L")="" ; Initialize location (2)
S BAR("B")="" ; Initialize Batch (3)
S BAR("IT")="" ; Initialize Item (4)
S BAR("SORT")="" ; Initialize sort (5)
S BAR("ACCT")="" ; Initialize A/R account (6)
S BAR("Z")="TMP("_$J_",""BAR-TAR"""
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")) D SUBHD
. S BAR("TXT")=$P($P(BAR,",",4,99),"""",2)
. S BAR("TXT")=$P(BAR,",",3)_U_BAR("TXT") ; Subscipts
. S BAR("TXTO")=BAR("TXT")
. S BAR("TXT")=$P(BAR("TXTO"),U)_U_$P(BAR("TXTO"),U,3,99)_U_$P(BAR("TXTO"),U,2)
. S BAR("NODE")=@BAR ; Data
. S BAR(1)=$P(BAR("NODE"),U) ; Bill number
. S BAR(2)=$P(BAR("NODE"),U,2) ; PAY-AMT
. S BAR(3)=$P(BAR("NODE"),U,3) ; PRV-CRD
. S BAR(4)=$P(BAR("NODE"),U,4) ; Refund
. S BAR(5)=$P(BAR("NODE"),U,5) ; Payment
. S BAR(6)=$P(BAR("NODE"),U,6) ; Bill Amount
. S BAR(7)=$P(BAR("NODE"),U,7) ; Adjustment
. I $D(BARY("AR")),BAR("AR")'=$P(BAR("TXT"),U) D
. . S BAR("L")=""
. . D SUBHD
. S BAR("AR")=$P(BAR("TXT"),U)
. ;;
. I BAR("L")'=$P(BAR("TXT"),U,2) D
. . I BAR("L")]"" D
. . . Q:$G(BAR("F1"))
. . . W !,BARDASH
. . . D SUB5,SUB4,SUB3,SUB2,SUB
. . . W !
. . W !?10,"Visit Location.......: ",$P(BAR("TXT"),U,2)
. . S (BAR("B"),BAR("IT"),BAR("SORT"),BAR("ACCT"))=""
. S BAR("L")=$P(BAR("TXT"),U,2)
. ;;
. I BAR("B")'=$P(BAR("TXT"),U,3) D
. . I BAR("B")]"" D
. . . Q:$G(BAR("F1"))
. . . W !,BARDASH
. . . D SUB5,SUB4,SUB3,SUB2
. . . W !
. . W !?10,"Collection Batch.....: "
. . ;I +$P(BAR("TXT"),U,3) W $P(^BARCOL($P(BAR("TXT"),U,8),$P(BAR("TXT"),U,3),0),U)
. . I +$P(BAR("TXT"),U,3),$P($G(^BARCOL($P(BAR("TXT"),U,8),$P(BAR("TXT"),U,3),0)),U)'="" D
. . . W $P($G(^BARCOL($P(BAR("TXT"),U,8),$P(BAR("TXT"),U,3),0)),U) ;IM17362
. . E W $P(BAR("TXT"),U,3)
. . S (BAR("IT"),BAR("SORT"),BAR("ACCT"))=""
. S BAR("B")=$P(BAR("TXT"),U,3)
. ;;
. I BAR("IT")'=$P(BAR("TXT"),U,4) D
. . I BAR("IT")]"" D
. . . Q:$G(BAR("F1"))
. . . W !,BARDASH
. . . D SUB5,SUB4,SUB3
. . . W !
. . W !?10,"Collection Batch Item: "
. . ;I +$P(BAR("TXT"),U,4) W $P(^BARCOL($P(BAR("TXT"),U,8),BAR("B"),1,$P(BAR("TXT"),U,4),0),U)
. . I +$P(BAR("TXT"),U,4),$P($G(^BARCOL($P(BAR("TXT"),U,8),BAR("B"),1,$P(BAR("TXT"),U,4),0)),U)'="" D
. . . W $P(^BARCOL($P(BAR("TXT"),U,8),BAR("B"),1,$P(BAR("TXT"),U,4),0),U) ;IM17362
. . E W $P(BAR("TXT"),U,4)
. . S (BAR("SORT"),BAR("ACCT"))=""
. S BAR("IT")=$P(BAR("TXT"),U,4)
. ;;
. I BAR("SORT")'=$P(BAR("TXT"),U,5) D
. . I BAR("SORT")]"" D
. . . Q:$G(BAR("F1"))
. . . W !,BARDASH
. . . D SUB5,SUB4
. . . W !
. . I BARY("SORT")="C" D
. . . W !?10,"Clinic Type..........: "
. . . I $P(BAR("TXT"),U,5)=99999 W "NO CLINIC" Q
. . . W $P(^DIC(40.7,$P(BAR("TXT"),U,5),0),U)
. . E D
. . . W !?10,"Visit Type...........: "
. . . I $P(BAR("TXT"),U,5)=99999 W "NO VISIT TYPE" Q
. . . W $P($G(^ABMDVTYP($P(BAR("TXT"),U,5),0)),U)
. . S BAR("ACCT")=""
. S BAR("SORT")=$P(BAR("TXT"),U,5)
. ;;
. I BAR("ACCT")'=$P(BAR("TXT"),U,6) D
. . I BAR("ACCT")]"" D
. . . Q:$G(BAR("F1"))
. . . W !,BARDASH
. . . D SUB5
. . . W !
. . W !?10,"A/R Account..........: ",$P(BAR("TXT"),U,6),!
. S BAR("ACCT")=$P(BAR("TXT"),U,6)
. W !,$E(BAR(1),1,14) ; A/R Bill
. W ?15,$J($FN(BAR(2),",",2),10) ; PAY-AMT
. W ?26,$J($FN(BAR(3),",",2),10) ; PRV-CRD
. W ?37,$J($FN(BAR(4),",",2),10) ; Refund
. W ?48,$J($FN(BAR(5),",",2),10) ; Payment
. W ?59,$J($FN(BAR(6),",",2),10) ; Bill Amt
. W ?70,$J($FN(BAR(7),",",2),10) ; Adjustment
. F I=0:1:5 D ; Accumulate totals
. . S Y=1
. . F X="PATOT","PCTOT","RTOT","PTOT","BTOT","ATOT" D
. . . S Y=Y+1
. . . S BARV=X_I
. . . S BARV2="BAR("""_BARV_""")"
. . . S @BARV2=@BARV2+BAR(Y)
Q:$G(BAR("F1"))
W !,BARDASH
D SUB5,SUB4,SUB3,SUB2,SUB,TOT
Q
; *********************************************************************
;
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")
Q
; *********************************************************************
;
SUBHD ;
; If A/R clerk specified
Q:'$D(BARY("AR"))
Q:'+$P(BAR("TXT"),U)
W !!,"A/R Entry Clerk: ",$P(^VA(200,$P(BAR("TXT"),U),0),U)
Q
; *********************************************************************
;
SUB ;
; Totals by Visit location.
Q:'BAR("BTOT1")
W !,"Location Tot:"
W ?15,$J($FN(BAR("PATOT1"),",",2),10)
W ?26,$J($FN(BAR("PCTOT1"),",",2),10)
W ?37,$J($FN(BAR("RTOT1"),",",2),10)
W ?48,$J($FN(BAR("PTOT1"),",",2),10)
W ?59,$J($FN(BAR("BTOT1"),",",2),10)
W ?70,$J($FN(BAR("ATOT1"),",",2),10)
S (BAR("PATOT1"),BAR("PCTOT1"),BAR("RTOT1"),BAR("PTOT1"),BAR("BTOT1"),BAR("ATOT1"))=0
Q
; *********************************************************************
;
SUB2 ;
; Totals by Collection Batch
Q:'BAR("BTOT2")
W !," Batch Tot:"
W ?15,$J($FN(BAR("PATOT2"),",",2),10)
W ?26,$J($FN(BAR("PCTOT2"),",",2),10)
W ?37,$J($FN(BAR("RTOT2"),",",2),10)
W ?48,$J($FN(BAR("PTOT2"),",",2),10)
W ?59,$J($FN(BAR("BTOT2"),",",2),10)
W ?70,$J($FN(BAR("ATOT2"),",",2),10)
S (BAR("PATOT2"),BAR("PCTOT2"),BAR("RTOT2"),BAR("PTOT2"),BAR("BTOT2"),BAR("ATOT2"))=0
Q
; *********************************************************************
;
SUB3 ;
; Totals by Collection Batch Item
Q:'BAR("BTOT3")
W !," Item Tot:"
W ?15,$J($FN(BAR("PATOT3"),",",2),10)
W ?26,$J($FN(BAR("PCTOT3"),",",2),10)
W ?37,$J($FN(BAR("RTOT3"),",",2),10)
W ?48,$J($FN(BAR("PTOT3"),",",2),10)
W ?59,$J($FN(BAR("BTOT3"),",",2),10)
W ?70,$J($FN(BAR("ATOT3"),",",2),10)
S (BAR("PATOT3"),BAR("PCTOT3"),BAR("RTOT3"),BAR("PTOT3"),BAR("BTOT3"),BAR("ATOT3"))=0
Q
; *********************************************************************
;
SUB4 ;
; Totals by Sort type
Q:'BAR("BTOT4")
I BARY("SORT")="C" W !," Clinic Tot:"
E W !," Visit Tot"
W ?15,$J($FN(BAR("PATOT4"),",",2),10)
W ?26,$J($FN(BAR("PCTOT4"),",",2),10)
W ?37,$J($FN(BAR("RTOT4"),",",2),10)
W ?48,$J($FN(BAR("PTOT4"),",",2),10)
W ?59,$J($FN(BAR("BTOT4"),",",2),10)
W ?70,$J($FN(BAR("ATOT4"),",",2),10)
S (BAR("PATOT4"),BAR("PCTOT4"),BAR("RTOT4"),BAR("PTOT4"),BAR("BTOT4"),BAR("ATOT4"))=0
Q
; *********************************************************************
;
SUB5 ;
; totals by A/R Account
Q:'BAR("BTOT5")
W !,"A/R Acct Tot:"
W ?15,$J($FN(BAR("PATOT5"),",",2),10)
W ?26,$J($FN(BAR("PCTOT5"),",",2),10)
W ?37,$J($FN(BAR("RTOT5"),",",2),10)
W ?48,$J($FN(BAR("PTOT5"),",",2),10)
W ?59,$J($FN(BAR("BTOT5"),",",2),10)
W ?70,$J($FN(BAR("ATOT5"),",",2),10)
S (BAR("PATOT5"),BAR("PCTOT5"),BAR("RTOT5"),BAR("PTOT5"),BAR("BTOT5"),BAR("ATOT5"))=0
Q
; *********************************************************************
;
TOT ;
; Report (a/r clerk) totals
Q:'BAR("BTOT0")
W !,BAREQUAL
W !,"REPORT TOTAL"
W ?15,$J($FN(BAR("PATOT0"),",",2),10)
W ?26,$J($FN(BAR("PCTOT0"),",",2),10)
W ?37,$J($FN(BAR("RTOT0"),",",2),10)
W ?48,$J($FN(BAR("PTOT0"),",",2),10)
W ?59,$J($FN(BAR("BTOT0"),",",2),10)
W ?70,$J($FN(BAR("ATOT0"),",",2),10)
S (BAR("PATOT0"),BAR("PCTOT0"),BAR("RTOT0"),BAR("PTOT0"),BAR("BTOT0"),BAR("ATOT0"))=0
Q
BARRTAR2 ; IHS/SD/LSL - Transaction report ;08/20/2008
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**1,7**;MAR 27,2007
+2 ; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892
+3 ; IHS/ASDS/LSL - 10/05/00 - Routine created
+4 ; Detail print of Transaction report
+5 ;
+6 ; IHS/SD/LSL - 07/10/02 - V1.6 Patch 2
+7 ; Modified to print missing clinics and visit types
+8 ;
+9 ; IHS/SD/LSL - 10/24/02 - V1.7 - PAB-1002-90130
+10 ; Modified to accomodate DUZ(2) subscript
+11 ;
+12 ; IHS/SD/RTL - 5/23/05 - V1.8 Patch 1 - IM17362
+13 ; TAR report bombing - missing collection batch
+14 ;
+15 QUIT
+16 ; *********************************************************************
+17 ;
DETAIL ; EP
+1 ; Print Detail
+2 SET BAR("COL")="W !,""Bill Number"",?15,""PAY-AMT"",?26,""PRV-CRD"",?37,""REFUND"",?48,""PAYMENT"",?59,""BILL AMT"",?70,""ADJUSTMENT"""
+3 SET BAR("HD",0)="DETAIL Transaction"_$PIECE(BAR("HD",0),"Transaction",2,99)
+4 ; Page and column header
DO HDB
+5 ; Initialize totals
FOR I=0:1:5
Begin DoDot:1
+6 SET Y=1
+7 FOR X="PATOT","PCTOT","RTOT","PTOT","BTOT","ATOT"
Begin DoDot:2
+8 SET Y=Y+1
+9 SET BARV=X_I
+10 SET BARV2="BAR("""_BARV_""")"
+11 SET @BARV2=0
End DoDot:2
End DoDot:1
+12 KILL I,Y,X
+13 SET BARDASH=" ---------- ---------- ---------- ---------- ---------- ----------"
+14 SET BAREQUAL=" ========== ========== ========== ========== ========== =========="
+15 ; Initialize A/R Clerk (1)
SET BAR("AR")=""
+16 ; Initialize location (2)
SET BAR("L")=""
+17 ; Initialize Batch (3)
SET BAR("B")=""
+18 ; Initialize Item (4)
SET BAR("IT")=""
+19 ; Initialize sort (5)
SET BAR("SORT")=""
+20 ; Initialize A/R account (6)
SET BAR("ACCT")=""
+21 SET BAR("Z")="TMP("_$JOB_",""BAR-TAR"""
+22 SET BAR="^"_BAR("Z")_")"
+23 ; No data, message, quit
IF '$DATA(@BAR)
Begin DoDot:1
+24 WRITE !!!!!?25,"*** NO DATA TO PRINT ***"
+25 DO EOP^BARUTL(0)
End DoDot:1
QUIT
+26 ; traverse the temp global...
+27 FOR
SET BAR=$QUERY(@BAR)
IF BAR'[BAR("Z")
QUIT
Begin DoDot:1
+28 IF $Y>(IOSL-5)
DO HD
IF $GET(BAR("F1"))
QUIT
DO SUBHD
+29 SET BAR("TXT")=$PIECE($PIECE(BAR,",",4,99),"""",2)
+30 ; Subscipts
SET BAR("TXT")=$PIECE(BAR,",",3)_U_BAR("TXT")
+31 SET BAR("TXTO")=BAR("TXT")
+32 SET BAR("TXT")=$PIECE(BAR("TXTO"),U)_U_$PIECE(BAR("TXTO"),U,3,99)_U_$PIECE(BAR("TXTO"),U,2)
+33 ; Data
SET BAR("NODE")=@BAR
+34 ; Bill number
SET BAR(1)=$PIECE(BAR("NODE"),U)
+35 ; PAY-AMT
SET BAR(2)=$PIECE(BAR("NODE"),U,2)
+36 ; PRV-CRD
SET BAR(3)=$PIECE(BAR("NODE"),U,3)
+37 ; Refund
SET BAR(4)=$PIECE(BAR("NODE"),U,4)
+38 ; Payment
SET BAR(5)=$PIECE(BAR("NODE"),U,5)
+39 ; Bill Amount
SET BAR(6)=$PIECE(BAR("NODE"),U,6)
+40 ; Adjustment
SET BAR(7)=$PIECE(BAR("NODE"),U,7)
+41 IF $DATA(BARY("AR"))
IF BAR("AR")'=$PIECE(BAR("TXT"),U)
Begin DoDot:2
+42 SET BAR("L")=""
+43 DO SUBHD
End DoDot:2
+44 SET BAR("AR")=$PIECE(BAR("TXT"),U)
+45 ;;
+46 IF BAR("L")'=$PIECE(BAR("TXT"),U,2)
Begin DoDot:2
+47 IF BAR("L")]""
Begin DoDot:3
+48 IF $GET(BAR("F1"))
QUIT
+49 WRITE !,BARDASH
+50 DO SUB5
DO SUB4
DO SUB3
DO SUB2
DO SUB
+51 WRITE !
End DoDot:3
+52 WRITE !?10,"Visit Location.......: ",$PIECE(BAR("TXT"),U,2)
+53 SET (BAR("B"),BAR("IT"),BAR("SORT"),BAR("ACCT"))=""
End DoDot:2
+54 SET BAR("L")=$PIECE(BAR("TXT"),U,2)
+55 ;;
+56 IF BAR("B")'=$PIECE(BAR("TXT"),U,3)
Begin DoDot:2
+57 IF BAR("B")]""
Begin DoDot:3
+58 IF $GET(BAR("F1"))
QUIT
+59 WRITE !,BARDASH
+60 DO SUB5
DO SUB4
DO SUB3
DO SUB2
+61 WRITE !
End DoDot:3
+62 WRITE !?10,"Collection Batch.....: "
+63 ;I +$P(BAR("TXT"),U,3) W $P(^BARCOL($P(BAR("TXT"),U,8),$P(BAR("TXT"),U,3),0),U)
+64 IF +$PIECE(BAR("TXT"),U,3)
IF $PIECE($GET(^BARCOL($PIECE(BAR("TXT"),U,8),$PIECE(BAR("TXT"),U,3),0)),U)'=""
Begin DoDot:3
+65 ;IM17362
WRITE $PIECE($GET(^BARCOL($PIECE(BAR("TXT"),U,8),$PIECE(BAR("TXT"),U,3),0)),U)
End DoDot:3
+66 IF '$TEST
WRITE $PIECE(BAR("TXT"),U,3)
+67 SET (BAR("IT"),BAR("SORT"),BAR("ACCT"))=""
End DoDot:2
+68 SET BAR("B")=$PIECE(BAR("TXT"),U,3)
+69 ;;
+70 IF BAR("IT")'=$PIECE(BAR("TXT"),U,4)
Begin DoDot:2
+71 IF BAR("IT")]""
Begin DoDot:3
+72 IF $GET(BAR("F1"))
QUIT
+73 WRITE !,BARDASH
+74 DO SUB5
DO SUB4
DO SUB3
+75 WRITE !
End DoDot:3
+76 WRITE !?10,"Collection Batch Item: "
+77 ;I +$P(BAR("TXT"),U,4) W $P(^BARCOL($P(BAR("TXT"),U,8),BAR("B"),1,$P(BAR("TXT"),U,4),0),U)
+78 IF +$PIECE(BAR("TXT"),U,4)
IF $PIECE($GET(^BARCOL($PIECE(BAR("TXT"),U,8),BAR("B"),1,$PIECE(BAR("TXT"),U,4),0)),U)'=""
Begin DoDot:3
+79 ;IM17362
WRITE $PIECE(^BARCOL($PIECE(BAR("TXT"),U,8),BAR("B"),1,$PIECE(BAR("TXT"),U,4),0),U)
End DoDot:3
+80 IF '$TEST
WRITE $PIECE(BAR("TXT"),U,4)
+81 SET (BAR("SORT"),BAR("ACCT"))=""
End DoDot:2
+82 SET BAR("IT")=$PIECE(BAR("TXT"),U,4)
+83 ;;
+84 IF BAR("SORT")'=$PIECE(BAR("TXT"),U,5)
Begin DoDot:2
+85 IF BAR("SORT")]""
Begin DoDot:3
+86 IF $GET(BAR("F1"))
QUIT
+87 WRITE !,BARDASH
+88 DO SUB5
DO SUB4
+89 WRITE !
End DoDot:3
+90 IF BARY("SORT")="C"
Begin DoDot:3
+91 WRITE !?10,"Clinic Type..........: "
+92 IF $PIECE(BAR("TXT"),U,5)=99999
WRITE "NO CLINIC"
QUIT
+93 WRITE $PIECE(^DIC(40.7,$PIECE(BAR("TXT"),U,5),0),U)
End DoDot:3
+94 IF '$TEST
Begin DoDot:3
+95 WRITE !?10,"Visit Type...........: "
+96 IF $PIECE(BAR("TXT"),U,5)=99999
WRITE "NO VISIT TYPE"
QUIT
+97 WRITE $PIECE($GET(^ABMDVTYP($PIECE(BAR("TXT"),U,5),0)),U)
End DoDot:3
+98 SET BAR("ACCT")=""
End DoDot:2
+99 SET BAR("SORT")=$PIECE(BAR("TXT"),U,5)
+100 ;;
+101 IF BAR("ACCT")'=$PIECE(BAR("TXT"),U,6)
Begin DoDot:2
+102 IF BAR("ACCT")]""
Begin DoDot:3
+103 IF $GET(BAR("F1"))
QUIT
+104 WRITE !,BARDASH
+105 DO SUB5
+106 WRITE !
End DoDot:3
+107 WRITE !?10,"A/R Account..........: ",$PIECE(BAR("TXT"),U,6),!
End DoDot:2
+108 SET BAR("ACCT")=$PIECE(BAR("TXT"),U,6)
+109 ; A/R Bill
WRITE !,$EXTRACT(BAR(1),1,14)
+110 ; PAY-AMT
WRITE ?15,$JUSTIFY($FNUMBER(BAR(2),",",2),10)
+111 ; PRV-CRD
WRITE ?26,$JUSTIFY($FNUMBER(BAR(3),",",2),10)
+112 ; Refund
WRITE ?37,$JUSTIFY($FNUMBER(BAR(4),",",2),10)
+113 ; Payment
WRITE ?48,$JUSTIFY($FNUMBER(BAR(5),",",2),10)
+114 ; Bill Amt
WRITE ?59,$JUSTIFY($FNUMBER(BAR(6),",",2),10)
+115 ; Adjustment
WRITE ?70,$JUSTIFY($FNUMBER(BAR(7),",",2),10)
+116 ; Accumulate totals
FOR I=0:1:5
Begin DoDot:2
+117 SET Y=1
+118 FOR X="PATOT","PCTOT","RTOT","PTOT","BTOT","ATOT"
Begin DoDot:3
+119 SET Y=Y+1
+120 SET BARV=X_I
+121 SET BARV2="BAR("""_BARV_""")"
+122 SET @BARV2=@BARV2+BAR(Y)
End DoDot:3
End DoDot:2
End DoDot:1
IF $GET(BAR("F1"))
QUIT
+123 IF $GET(BAR("F1"))
QUIT
+124 WRITE !,BARDASH
+125 DO SUB5
DO SUB4
DO SUB3
DO SUB2
DO SUB
DO TOT
+126 QUIT
+127 ; *********************************************************************
+128 ;
HD ; EP
+1 DO PAZ^BARRUTL
+2 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
SET BAR("F1")=1
QUIT
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 ;
SUBHD ;
+1 ; If A/R clerk specified
+2 IF '$DATA(BARY("AR"))
QUIT
+3 IF '+$PIECE(BAR("TXT"),U)
QUIT
+4 WRITE !!,"A/R Entry Clerk: ",$PIECE(^VA(200,$PIECE(BAR("TXT"),U),0),U)
+5 QUIT
+6 ; *********************************************************************
+7 ;
SUB ;
+1 ; Totals by Visit location.
+2 IF 'BAR("BTOT1")
QUIT
+3 WRITE !,"Location Tot:"
+4 WRITE ?15,$JUSTIFY($FNUMBER(BAR("PATOT1"),",",2),10)
+5 WRITE ?26,$JUSTIFY($FNUMBER(BAR("PCTOT1"),",",2),10)
+6 WRITE ?37,$JUSTIFY($FNUMBER(BAR("RTOT1"),",",2),10)
+7 WRITE ?48,$JUSTIFY($FNUMBER(BAR("PTOT1"),",",2),10)
+8 WRITE ?59,$JUSTIFY($FNUMBER(BAR("BTOT1"),",",2),10)
+9 WRITE ?70,$JUSTIFY($FNUMBER(BAR("ATOT1"),",",2),10)
+10 SET (BAR("PATOT1"),BAR("PCTOT1"),BAR("RTOT1"),BAR("PTOT1"),BAR("BTOT1"),BAR("ATOT1"))=0
+11 QUIT
+12 ; *********************************************************************
+13 ;
SUB2 ;
+1 ; Totals by Collection Batch
+2 IF 'BAR("BTOT2")
QUIT
+3 WRITE !," Batch Tot:"
+4 WRITE ?15,$JUSTIFY($FNUMBER(BAR("PATOT2"),",",2),10)
+5 WRITE ?26,$JUSTIFY($FNUMBER(BAR("PCTOT2"),",",2),10)
+6 WRITE ?37,$JUSTIFY($FNUMBER(BAR("RTOT2"),",",2),10)
+7 WRITE ?48,$JUSTIFY($FNUMBER(BAR("PTOT2"),",",2),10)
+8 WRITE ?59,$JUSTIFY($FNUMBER(BAR("BTOT2"),",",2),10)
+9 WRITE ?70,$JUSTIFY($FNUMBER(BAR("ATOT2"),",",2),10)
+10 SET (BAR("PATOT2"),BAR("PCTOT2"),BAR("RTOT2"),BAR("PTOT2"),BAR("BTOT2"),BAR("ATOT2"))=0
+11 QUIT
+12 ; *********************************************************************
+13 ;
SUB3 ;
+1 ; Totals by Collection Batch Item
+2 IF 'BAR("BTOT3")
QUIT
+3 WRITE !," Item Tot:"
+4 WRITE ?15,$JUSTIFY($FNUMBER(BAR("PATOT3"),",",2),10)
+5 WRITE ?26,$JUSTIFY($FNUMBER(BAR("PCTOT3"),",",2),10)
+6 WRITE ?37,$JUSTIFY($FNUMBER(BAR("RTOT3"),",",2),10)
+7 WRITE ?48,$JUSTIFY($FNUMBER(BAR("PTOT3"),",",2),10)
+8 WRITE ?59,$JUSTIFY($FNUMBER(BAR("BTOT3"),",",2),10)
+9 WRITE ?70,$JUSTIFY($FNUMBER(BAR("ATOT3"),",",2),10)
+10 SET (BAR("PATOT3"),BAR("PCTOT3"),BAR("RTOT3"),BAR("PTOT3"),BAR("BTOT3"),BAR("ATOT3"))=0
+11 QUIT
+12 ; *********************************************************************
+13 ;
SUB4 ;
+1 ; Totals by Sort type
+2 IF 'BAR("BTOT4")
QUIT
+3 IF BARY("SORT")="C"
WRITE !," Clinic Tot:"
+4 IF '$TEST
WRITE !," Visit Tot"
+5 WRITE ?15,$JUSTIFY($FNUMBER(BAR("PATOT4"),",",2),10)
+6 WRITE ?26,$JUSTIFY($FNUMBER(BAR("PCTOT4"),",",2),10)
+7 WRITE ?37,$JUSTIFY($FNUMBER(BAR("RTOT4"),",",2),10)
+8 WRITE ?48,$JUSTIFY($FNUMBER(BAR("PTOT4"),",",2),10)
+9 WRITE ?59,$JUSTIFY($FNUMBER(BAR("BTOT4"),",",2),10)
+10 WRITE ?70,$JUSTIFY($FNUMBER(BAR("ATOT4"),",",2),10)
+11 SET (BAR("PATOT4"),BAR("PCTOT4"),BAR("RTOT4"),BAR("PTOT4"),BAR("BTOT4"),BAR("ATOT4"))=0
+12 QUIT
+13 ; *********************************************************************
+14 ;
SUB5 ;
+1 ; totals by A/R Account
+2 IF 'BAR("BTOT5")
QUIT
+3 WRITE !,"A/R Acct Tot:"
+4 WRITE ?15,$JUSTIFY($FNUMBER(BAR("PATOT5"),",",2),10)
+5 WRITE ?26,$JUSTIFY($FNUMBER(BAR("PCTOT5"),",",2),10)
+6 WRITE ?37,$JUSTIFY($FNUMBER(BAR("RTOT5"),",",2),10)
+7 WRITE ?48,$JUSTIFY($FNUMBER(BAR("PTOT5"),",",2),10)
+8 WRITE ?59,$JUSTIFY($FNUMBER(BAR("BTOT5"),",",2),10)
+9 WRITE ?70,$JUSTIFY($FNUMBER(BAR("ATOT5"),",",2),10)
+10 SET (BAR("PATOT5"),BAR("PCTOT5"),BAR("RTOT5"),BAR("PTOT5"),BAR("BTOT5"),BAR("ATOT5"))=0
+11 QUIT
+12 ; *********************************************************************
+13 ;
TOT ;
+1 ; Report (a/r clerk) totals
+2 IF 'BAR("BTOT0")
QUIT
+3 WRITE !,BAREQUAL
+4 WRITE !,"REPORT TOTAL"
+5 WRITE ?15,$JUSTIFY($FNUMBER(BAR("PATOT0"),",",2),10)
+6 WRITE ?26,$JUSTIFY($FNUMBER(BAR("PCTOT0"),",",2),10)
+7 WRITE ?37,$JUSTIFY($FNUMBER(BAR("RTOT0"),",",2),10)
+8 WRITE ?48,$JUSTIFY($FNUMBER(BAR("PTOT0"),",",2),10)
+9 WRITE ?59,$JUSTIFY($FNUMBER(BAR("BTOT0"),",",2),10)
+10 WRITE ?70,$JUSTIFY($FNUMBER(BAR("ATOT0"),",",2),10)
+11 SET (BAR("PATOT0"),BAR("PCTOT0"),BAR("RTOT0"),BAR("PTOT0"),BAR("BTOT0"),BAR("ATOT0"))=0
+12 QUIT
