Routine: BARRTAR

BARRTAR ; IHS/SD/LSL - Transaction report ; 08/20/2008

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

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

 ; IHS/ASDS/LSL - 10/02/00 - Routine created

 ; IHS/SD/LSL - 04/19/02 - V1.6 Patch 2

 ;     Modified to accomodate new "Location to sort report by" parameter

 ; IHS/SD/LSL - 10/24/02 - V1.7 - PAB-1002-90130

 ;      Modified to insert DUZ(2) as subscript in data global.  Needed to

 ;      pull correct Collection Batch and Item from A/R Global during print

 ;      due to "location to sort report by" parameter edits.

 ; IHS/SD/LSL - 06/20/03 - V1.7 Patch 2 - IM10890

 ;      Remove tran type 115 (coll batch to acct post) from report

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

EN ; EP

 K BARY,BAR

 D:'$D(BARUSR) INIT^BARUTL         ; Setup basic A/R variables

 S BARP("RTN")="BARRTAR"           ; Routine used to get data

 S BAR("PRIVACY")=1                ; Privacy act applies

 S BAR("LOC")=$$GET1^DIQ(90052.06,DUZ(2),16)   ; BILLING or VISIT

 I BAR("LOC")="" S BAR("LOC")="VISIT"

 D ^BARRSEL                        ; Select exclusion parameters

 I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q

 I $D(BARY("RTYP")) S BAR("HD",0)=BARY("RTYP","NM")_" "_BARMENU

 E  S BAR("HD",0)=BARMENU

 D ^BARRHD                         ; Report header

 S BARQ("RC")="COMPUTE^BARRTAR"    ; Compute routine

 S BARQ("RP")="PRINT^BARRTAR"      ; Print routine

 S BARQ("NS")="BAR"                ; Namespace for variables

 S BARQ("RX")="POUT^BARRUTL"       ; Clean-up routine

 D ^BARDBQUE                       ; Double queuing

 D PAZ^BARRUTL

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

COMPUTE ;

 S BAR("SUBR")="BAR-TAR"

 K ^TMP($J,"BAR-TAR")

 K ^TMP($J,"BAR-TARS")

 I BAR("LOC")="BILLING" D TRANS^BARRUTL Q

 S BARDUZ2=DUZ(2)

 S DUZ(2)=0

 F  S DUZ(2)=$O(^BARTR(DUZ(2))) Q:'DUZ(2)  D TRANS^BARRUTL

 S DUZ(2)=BARDUZ2

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

DATA ; EP

 ; Called by BARRUTL if no parameters

 F I=2:1:7 S BAR(I)=0

 S BARP("HIT")=0

 D TRANS^BARRCHK

 Q:'BARP("HIT")

 S BAR("SORT")=$S(BARY("SORT")="C":BAR("C"),1:BAR("V"))

 I BARTR("I")]"" S BAR("ACCT")=$$VAL^XBDIQ1(90050.02,BARTR("I"),.01)

 I BAR("ACCT")="" S BAR("ACCT")="No A/R Account"   ; External A/R Acct

 S BARTR("L")=$$VAL^XBDIQ1(9999999.06,BARTR("L"),.01)  ; External location

 S BAR("TRANS")=$P(BARTR(1),U)                     ; Transaction type

 S BAR("ADJCAT")=$P(BARTR(1),U,2)                  ; Adjustment Category

 ;IHS/SD/PKD bar*1.8*21 Add Sent to Collections 25&993 to Adj/Trans

 ;I ",3,4,13,14,15,16,19,20,"'[(","_BAR("ADJCAT")_",")&(",40,100,"'[(","_BAR("TRANS")_",")) Q

 I ",3,4,13,14,15,16,19,20,25,"'[(","_BAR("ADJCAT")_",")&(",40,100,993,"'[(","_BAR("TRANS")_",")) Q

 S BAR("CR-DB")=$$VAL^XBDIQ1(90050.03,BARTR,3.5)   ; Credits - Debits

 S BAR(1)=$E($P(BAR(0),U),1,14)                    ; Bill number

 S:BAR("TRANS")=40 BAR(2)=BAR("CR-DB")             ; Payment Amount

 S:BAR("ADJCAT")=20 BAR(3)=BAR("CR-DB")            ; Previous credits

 S:BAR("ADJCAT")=19 BAR(4)=BAR("CR-DB")            ; Refund

 I +BAR(2)!(+BAR(3))!(+BAR(4)) S BAR(5)=BAR("CR-DB")  ; Payment

 S BAR(6)=$P(BAR(0),U,13)                          ; Billed Amount

 ; Adjustments

 ; IHS/SD/PKD bar*1.8*21 Include Sent to collections to Adj Cat

 ;I ",3,4,13,14,15,16,"[(","_BAR("ADJCAT")_",") S BAR(7)=BAR("CR-DB")

 I ",3,4,13,14,15,16,25,"[(","_BAR("ADJCAT")_",") S BAR(7)=BAR("CR-DB")

 ; For detail

 S BARHLD=$G(^TMP($J,"BAR-TAR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BARTR("B")_U_BARTR("IT")_U_BAR("SORT")_U_BAR("ACCT")_U_BAR))

 S $P(^TMP($J,"BAR-TAR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BARTR("B")_U_BARTR("IT")_U_BAR("SORT")_U_BAR("ACCT")_U_BAR),U)=BAR(1)

 S $P(^TMP($J,"BAR-TAR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BARTR("B")_U_BARTR("IT")_U_BAR("SORT")_U_BAR("ACCT")_U_BAR),U,2)=$P(BARHLD,U,2)+BAR(2)

 S $P(^TMP($J,"BAR-TAR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BARTR("B")_U_BARTR("IT")_U_BAR("SORT")_U_BAR("ACCT")_U_BAR),U,3)=$P(BARHLD,U,3)+BAR(3)

 S $P(^TMP($J,"BAR-TAR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BARTR("B")_U_BARTR("IT")_U_BAR("SORT")_U_BAR("ACCT")_U_BAR),U,4)=$P(BARHLD,U,4)+BAR(4)

 S $P(^TMP($J,"BAR-TAR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BARTR("B")_U_BARTR("IT")_U_BAR("SORT")_U_BAR("ACCT")_U_BAR),U,5)=$P(BARHLD,U,5)+BAR(5)

 S $P(^TMP($J,"BAR-TAR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BARTR("B")_U_BARTR("IT")_U_BAR("SORT")_U_BAR("ACCT")_U_BAR),U,6)=BAR(6)

 S $P(^TMP($J,"BAR-TAR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BARTR("B")_U_BARTR("IT")_U_BAR("SORT")_U_BAR("ACCT")_U_BAR),U,7)=$P(BARHLD,U,7)+BAR(7)

 ;BEGIN BAR*1.8*6 IHS/SD/TPF 8/6/2008 IM30075

 ;S BARHLD=$G(^TMP($J,"BAR-TAR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BARTR("B")_U_BARTR("IT")_U_BAR("SORT")_U_BAR("ACCT")_U_BAR_U_BARTR))

 ;S $P(^TMP($J,"BAR-TAR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BARTR("B")_U_BARTR("IT")_U_BAR("SORT")_U_BAR("ACCT")_U_BAR_U_BARTR),U)=BAR(1)

 ;S $P(^TMP($J,"BAR-TAR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BARTR("B")_U_BARTR("IT")_U_BAR("SORT")_U_BAR("ACCT")_U_BAR_U_BARTR),U,2)=$P(BARHLD,U,2)+BAR(2)

 ;S $P(^TMP($J,"BAR-TAR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BARTR("B")_U_BARTR("IT")_U_BAR("SORT")_U_BAR("ACCT")_U_BAR_U_BARTR),U,3)=$P(BARHLD,U,3)+BAR(3)

 ;S $P(^TMP($J,"BAR-TAR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BARTR("B")_U_BARTR("IT")_U_BAR("SORT")_U_BAR("ACCT")_U_BAR_U_BARTR),U,4)=$P(BARHLD,U,4)+BAR(4)

 ;S $P(^TMP($J,"BAR-TAR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BARTR("B")_U_BARTR("IT")_U_BAR("SORT")_U_BAR("ACCT")_U_BAR_U_BARTR),U,5)=$P(BARHLD,U,5)+BAR(5)

 ;S $P(^TMP($J,"BAR-TAR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BARTR("B")_U_BARTR("IT")_U_BAR("SORT")_U_BAR("ACCT")_U_BAR_U_BARTR),U,6)=BAR(6)

 ;S $P(^TMP($J,"BAR-TAR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BARTR("B")_U_BARTR("IT")_U_BAR("SORT")_U_BAR("ACCT")_U_BAR_U_BARTR),U,7)=$P(BARHLD,U,7)+BAR(7)

 ;END BAR*1.8*6 IHS/SD/TPF 8/6/2008 IM30075

 ; For summary

 S BARHLD2=$G(^TMP($J,"BAR-TARS",BARTR("AR"),DUZ(2),BARTR("L"),BARTR("B"),BARTR("IT"),BAR("SORT"),BAR("ACCT")))

 S $P(^TMP($J,"BAR-TARS",BARTR("AR"),DUZ(2),BARTR("L"),BARTR("B"),BARTR("IT"),BAR("SORT"),BAR("ACCT")),U,2)=$P(BARHLD2,U,2)+BAR(2)

 S $P(^TMP($J,"BAR-TARS",BARTR("AR"),DUZ(2),BARTR("L"),BARTR("B"),BARTR("IT"),BAR("SORT"),BAR("ACCT")),U,3)=$P(BARHLD2,U,3)+BAR(3)

 S $P(^TMP($J,"BAR-TARS",BARTR("AR"),DUZ(2),BARTR("L"),BARTR("B"),BARTR("IT"),BAR("SORT"),BAR("ACCT")),U,4)=$P(BARHLD2,U,4)+BAR(4)

 S $P(^TMP($J,"BAR-TARS",BARTR("AR"),DUZ(2),BARTR("L"),BARTR("B"),BARTR("IT"),BAR("SORT"),BAR("ACCT")),U,5)=$P(BARHLD2,U,5)+BAR(5)

 S $P(^TMP($J,"BAR-TARS",BARTR("AR"),DUZ(2),BARTR("L"),BARTR("B"),BARTR("IT"),BAR("SORT"),BAR("ACCT")),U,6)=$P(BARHLD2,U,6)+BAR(6)

 S $P(^TMP($J,"BAR-TARS",BARTR("AR"),DUZ(2),BARTR("L"),BARTR("B"),BARTR("IT"),BAR("SORT"),BAR("ACCT")),U,7)=$P(BARHLD2,U,7)+BAR(7)

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

PRINT ; EP

 ; Print

 S BAR("PG")=0

 I BARY("RTYP")=1 D DETAIL^BARRTAR2,FOOTER

 I BARY("RTYP")=2 D SUMM^BARRTAR3,FOOTER

 I BARY("RTYP")=3 D

 . D DETAIL^BARRTAR2

 . Q:'$D(@BAR)            ; No data

 . D PAZ^BARRUTL

 . Q:$G(BAR("F1"))

 . D SUMM^BARRTAR3

 . D FOOTER

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

FOOTER ;

 Q:$G(BAR("F1"))

 I $D(BAR("UN-ALLOCATED")) D

 . S X=""

 . K BAR("DUZ")

 . S X=$O(BAR("UN-ALLOCATED",X))

 . S BAR("DUZ")=$P(BAR("UN-ALLOCATED",X),U,2)

 . S BAR("COL")="W !!?10,""** Unallocated for Collection Batch "",$P(^BARCOL(BAR(""DUZ""),BARTR(""B""),0),U),"" **"",!!"

 . D PAZ^BARRUTL

 . D HDB^BARRTAR2

 . S BAR("UN")=""

 . F  S BAR("UN")=$O(BAR("UN-ALLOCATED",BAR("UN"))) Q:'BAR("UN")  D

 . . W !?15,"ITEM",?30,$J(BAR("UN"),3),?40,$J($FN($P(BAR("UN-ALLOCATED",BAR("UN")),U),",",2),10)

 . . S BAR("UNT")=$G(BAR("UNT"))+$P(BAR("UN-ALLOCATED",BAR("UN")),U)

 . W !?40,"----------"

 . W !?40,$J($FN(BAR("UNT"),",",2),10)

 I $D(BAR("ST")) D

 . W !!!!?16,"*****  R E P O R T  C O M P L E T E  *****"

 . D PAZ^BARRUTL

BARRTAR   ; IHS/SD/LSL - Transaction report ; 08/20/2008

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

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

 +3       ; IHS/ASDS/LSL - 10/02/00 - Routine created

 +4       ;

 +5       ; IHS/SD/LSL - 04/19/02 - V1.6 Patch 2

 +6       ;     Modified to accomodate new "Location to sort report by" parameter

 +7       ;

 +8       ; IHS/SD/LSL - 10/24/02 - V1.7 - PAB-1002-90130

 +9       ;      Modified to insert DUZ(2) as subscript in data global.  Needed to

 +10      ;      pull correct Collection Batch and Item from A/R Global during print

 +11      ;      due to "location to sort report by" parameter edits.

 +12      ;

 +13      ; IHS/SD/LSL - 06/20/03 - V1.7 Patch 2 - IM10890

 +14      ;      Remove tran type 115 (coll batch to acct post) from report

 +15      ;

 +16       QUIT

 +17      ; *********************************************************************

 +18      ;

EN        ; EP

 +1        KILL BARY,BAR

 +2       ; Setup basic A/R variables

           IF '$DATA(BARUSR)

               DO INIT^BARUTL

 +3       ; Routine used to get data

           SET BARP("RTN")="BARRTAR"

 +4       ; Privacy act applies

           SET BAR("PRIVACY")=1

 +5       ; BILLING or VISIT

           SET BAR("LOC")=$$GET1^DIQ(90052.06,DUZ(2),16)

 +6        IF BAR("LOC")=""

               SET BAR("LOC")="VISIT"

 +7       ; Select exclusion parameters

           DO ^BARRSEL

 +8        IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)

               QUIT

 +9        IF $DATA(BARY("RTYP"))

               SET BAR("HD",0)=BARY("RTYP","NM")_" "_BARMENU

 +10      IF '$TEST

               SET BAR("HD",0)=BARMENU

 +11      ; Report header

           DO ^BARRHD

 +12      ; Compute routine

           SET BARQ("RC")="COMPUTE^BARRTAR"

 +13      ; Print routine

           SET BARQ("RP")="PRINT^BARRTAR"

 +14      ; Namespace for variables

           SET BARQ("NS")="BAR"

 +15      ; Clean-up routine

           SET BARQ("RX")="POUT^BARRUTL"

 +16      ; Double queuing

           DO ^BARDBQUE

 +17       DO PAZ^BARRUTL

 +18       QUIT

 +19      ; *********************************************************************

 +20      ;

COMPUTE   ;

 +1       ;

 +2        SET BAR("SUBR")="BAR-TAR"

 +3        KILL ^TMP($JOB,"BAR-TAR")

 +4        KILL ^TMP($JOB,"BAR-TARS")

 +5        IF BAR("LOC")="BILLING"

               DO TRANS^BARRUTL

               QUIT

 +6        SET BARDUZ2=DUZ(2)

 +7        SET DUZ(2)=0

 +8        FOR

               SET DUZ(2)=$ORDER(^BARTR(DUZ(2)))

               IF 'DUZ(2)

                   QUIT

               DO TRANS^BARRUTL

 +9        SET DUZ(2)=BARDUZ2

 +10       QUIT

 +11      ; *********************************************************************

 +12      ;

DATA      ; EP

 +1       ; Called by BARRUTL if no parameters

 +2        FOR I=2:1:7

               SET BAR(I)=0

 +3        SET BARP("HIT")=0

 +4        DO TRANS^BARRCHK

 +5        IF 'BARP("HIT")

               QUIT

 +6        SET BAR("SORT")=$SELECT(BARY("SORT")="C":BAR("C"),1:BAR("V"))

 +7        IF BARTR("I")]""

               SET BAR("ACCT")=$$VAL^XBDIQ1(90050.02,BARTR("I"),.01)

 +8       ; External A/R Acct

           IF BAR("ACCT")=""

               SET BAR("ACCT")="No A/R Account"

 +9       ; External location

           SET BARTR("L")=$$VAL^XBDIQ1(9999999.06,BARTR("L"),.01)

 +10      ; Transaction type

           SET BAR("TRANS")=$PIECE(BARTR(1),U)

 +11      ; Adjustment Category

           SET BAR("ADJCAT")=$PIECE(BARTR(1),U,2)

 +12      ;IHS/SD/PKD bar*1.8*21 Add Sent to Collections 25&993 to Adj/Trans

 +13      ;I ",3,4,13,14,15,16,19,20,"'[(","_BAR("ADJCAT")_",")&(",40,100,"'[(","_BAR("TRANS")_",")) Q

 +14       IF ",3,4,13,14,15,16,19,20,25,"'[(","_BAR("ADJCAT")_",")&(",40,100,993,"'[(","_BAR("TRANS")_","))

               QUIT

 +15      ; Credits - Debits

           SET BAR("CR-DB")=$$VAL^XBDIQ1(90050.03,BARTR,3.5)

 +16      ; Bill number

           SET BAR(1)=$EXTRACT($PIECE(BAR(0),U),1,14)

 +17      ; Payment Amount

           IF BAR("TRANS")=40

               SET BAR(2)=BAR("CR-DB")

 +18      ; Previous credits

           IF BAR("ADJCAT")=20

               SET BAR(3)=BAR("CR-DB")

 +19      ; Refund

           IF BAR("ADJCAT")=19

               SET BAR(4)=BAR("CR-DB")

 +20      ; Payment

           IF +BAR(2)!(+BAR(3))!(+BAR(4))

               SET BAR(5)=BAR("CR-DB")

 +21      ; Billed Amount

           SET BAR(6)=$PIECE(BAR(0),U,13)

 +22      ; Adjustments

 +23      ; IHS/SD/PKD bar*1.8*21 Include Sent to collections to Adj Cat

 +24      ;I ",3,4,13,14,15,16,"[(","_BAR("ADJCAT")_",") S BAR(7)=BAR("CR-DB")

 +25       IF ",3,4,13,14,15,16,25,"[(","_BAR("ADJCAT")_",")

               SET BAR(7)=BAR("CR-DB")

 +26      ; For detail

 +27       SET BARHLD=$GET(^TMP($JOB,"BAR-TAR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BARTR("B")_U_BARTR("IT")_U_BAR("SORT")_U_BAR("ACCT")_U_BAR))

 +28       SET $PIECE(^TMP($JOB,"BAR-TAR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BARTR("B")_U_BARTR("IT")_U_BAR("SORT")_U_BAR("ACCT")_U_BAR),U)=BAR(1)

 +29       SET $PIECE(^TMP($JOB,"BAR-TAR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BARTR("B")_U_BARTR("IT")_U_BAR("SORT")_U_BAR("ACCT")_U_BAR),U,2)=$PIECE(BARHLD,U,2)+BAR(2)

 +30       SET $PIECE(^TMP($JOB,"BAR-TAR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BARTR("B")_U_BARTR("IT")_U_BAR("SORT")_U_BAR("ACCT")_U_BAR),U,3)=$PIECE(BARHLD,U,3)+BAR(3)

 +31       SET $PIECE(^TMP($JOB,"BAR-TAR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BARTR("B")_U_BARTR("IT")_U_BAR("SORT")_U_BAR("ACCT")_U_BAR),U,4)=$PIECE(BARHLD,U,4)+BAR(4)

 +32       SET $PIECE(^TMP($JOB,"BAR-TAR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BARTR("B")_U_BARTR("IT")_U_BAR("SORT")_U_BAR("ACCT")_U_BAR),U,5)=$PIECE(BARHLD,U,5)+BAR(5)

 +33       SET $PIECE(^TMP($JOB,"BAR-TAR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BARTR("B")_U_BARTR("IT")_U_BAR("SORT")_U_BAR("ACCT")_U_BAR),U,6)=BAR(6)

 +34       SET $PIECE(^TMP($JOB,"BAR-TAR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BARTR("B")_U_BARTR("IT")_U_BAR("SORT")_U_BAR("ACCT")_U_BAR),U,7)=$PIECE(BARHLD,U,7)+BAR(7)

 +35      ;BEGIN BAR*1.8*6 IHS/SD/TPF 8/6/2008 IM30075

 +36      ;S BARHLD=$G(^TMP($J,"BAR-TAR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BARTR("B")_U_BARTR("IT")_U_BAR("SORT")_U_BAR("ACCT")_U_BAR_U_BARTR))

 +37      ;S $P(^TMP($J,"BAR-TAR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BARTR("B")_U_BARTR("IT")_U_BAR("SORT")_U_BAR("ACCT")_U_BAR_U_BARTR),U)=BAR(1)

 +38      ;S $P(^TMP($J,"BAR-TAR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BARTR("B")_U_BARTR("IT")_U_BAR("SORT")_U_BAR("ACCT")_U_BAR_U_BARTR),U,2)=$P(BARHLD,U,2)+BAR(2)

 +39      ;S $P(^TMP($J,"BAR-TAR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BARTR("B")_U_BARTR("IT")_U_BAR("SORT")_U_BAR("ACCT")_U_BAR_U_BARTR),U,3)=$P(BARHLD,U,3)+BAR(3)

 +40      ;S $P(^TMP($J,"BAR-TAR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BARTR("B")_U_BARTR("IT")_U_BAR("SORT")_U_BAR("ACCT")_U_BAR_U_BARTR),U,4)=$P(BARHLD,U,4)+BAR(4)

 +41      ;S $P(^TMP($J,"BAR-TAR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BARTR("B")_U_BARTR("IT")_U_BAR("SORT")_U_BAR("ACCT")_U_BAR_U_BARTR),U,5)=$P(BARHLD,U,5)+BAR(5)

 +42      ;S $P(^TMP($J,"BAR-TAR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BARTR("B")_U_BARTR("IT")_U_BAR("SORT")_U_BAR("ACCT")_U_BAR_U_BARTR),U,6)=BAR(6)

 +43      ;S $P(^TMP($J,"BAR-TAR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BARTR("B")_U_BARTR("IT")_U_BAR("SORT")_U_BAR("ACCT")_U_BAR_U_BARTR),U,7)=$P(BARHLD,U,7)+BAR(7)

 +44      ;END BAR*1.8*6 IHS/SD/TPF 8/6/2008 IM30075

 +45      ; For summary

 +46       SET BARHLD2=$GET(^TMP($JOB,"BAR-TARS",BARTR("AR"),DUZ(2),BARTR("L"),BARTR("B"),BARTR("IT"),BAR("SORT"),BAR("ACCT")))

 +47       SET $PIECE(^TMP($JOB,"BAR-TARS",BARTR("AR"),DUZ(2),BARTR("L"),BARTR("B"),BARTR("IT"),BAR("SORT"),BAR("ACCT")),U,2)=$PIECE(BARHLD2,U,2)+BAR(2)

 +48       SET $PIECE(^TMP($JOB,"BAR-TARS",BARTR("AR"),DUZ(2),BARTR("L"),BARTR("B"),BARTR("IT"),BAR("SORT"),BAR("ACCT")),U,3)=$PIECE(BARHLD2,U,3)+BAR(3)

 +49       SET $PIECE(^TMP($JOB,"BAR-TARS",BARTR("AR"),DUZ(2),BARTR("L"),BARTR("B"),BARTR("IT"),BAR("SORT"),BAR("ACCT")),U,4)=$PIECE(BARHLD2,U,4)+BAR(4)

 +50       SET $PIECE(^TMP($JOB,"BAR-TARS",BARTR("AR"),DUZ(2),BARTR("L"),BARTR("B"),BARTR("IT"),BAR("SORT"),BAR("ACCT")),U,5)=$PIECE(BARHLD2,U,5)+BAR(5)

 +51       SET $PIECE(^TMP($JOB,"BAR-TARS",BARTR("AR"),DUZ(2),BARTR("L"),BARTR("B"),BARTR("IT"),BAR("SORT"),BAR("ACCT")),U,6)=$PIECE(BARHLD2,U,6)+BAR(6)

 +52       SET $PIECE(^TMP($JOB,"BAR-TARS",BARTR("AR"),DUZ(2),BARTR("L"),BARTR("B"),BARTR("IT"),BAR("SORT"),BAR("ACCT")),U,7)=$PIECE(BARHLD2,U,7)+BAR(7)

 +53       QUIT

 +54      ; *********************************************************************

 +55      ;

PRINT     ; EP

 +1       ; Print

 +2        SET BAR("PG")=0

 +3        IF BARY("RTYP")=1

               DO DETAIL^BARRTAR2

               DO FOOTER

 +4        IF BARY("RTYP")=2

               DO SUMM^BARRTAR3

               DO FOOTER

 +5        IF BARY("RTYP")=3

               Begin DoDot:1

 +6                DO DETAIL^BARRTAR2

 +7       ; No data

                   IF '$DATA(@BAR)

                       QUIT

 +8                DO PAZ^BARRUTL

 +9                IF $GET(BAR("F1"))

                       QUIT

 +10               DO SUMM^BARRTAR3

 +11               DO FOOTER

               End DoDot:1

 +12       QUIT

 +13      ; *********************************************************************

 +14      ;

FOOTER    ;

 +1        IF $GET(BAR("F1"))

               QUIT

 +2        IF $DATA(BAR("UN-ALLOCATED"))

               Begin DoDot:1

 +3                SET X=""

 +4                KILL BAR("DUZ")

 +5                SET X=$ORDER(BAR("UN-ALLOCATED",X))

 +6                SET BAR("DUZ")=$PIECE(BAR("UN-ALLOCATED",X),U,2)

 +7                SET BAR("COL")="W !!?10,""** Unallocated for Collection Batch "",$P(^BARCOL(BAR(""DUZ""),BARTR(""B""),0),U),"" **"",!!"

 +8                DO PAZ^BARRUTL

 +9                DO HDB^BARRTAR2

 +10               SET BAR("UN")=""

 +11               FOR

                       SET BAR("UN")=$ORDER(BAR("UN-ALLOCATED",BAR("UN")))

                       IF 'BAR("UN")

                           QUIT

                       Begin DoDot:2

 +12                       WRITE !?15,"ITEM",?30,$JUSTIFY(BAR("UN"),3),?40,$JUSTIFY($FNUMBER($PIECE(BAR("UN-ALLOCATED",BAR("UN")),U),",",2),10)

 +13                       SET BAR("UNT")=$GET(BAR("UNT"))+$PIECE(BAR("UN-ALLOCATED",BAR("UN")),U)

                       End DoDot:2

 +14               WRITE !?40,"----------"

 +15               WRITE !?40,$JUSTIFY($FNUMBER(BAR("UNT"),",",2),10)

               End DoDot:1

 +16       IF $DATA(BAR("ST"))

               Begin DoDot:1

 +17               WRITE !!!!?16,"*****  R E P O R T  C O M P L E T E  *****"

 +18               DO PAZ^BARRUTL

               End DoDot:1

 +19       QUIT

BARRTAR.m