BARRADJ.m

BARRADJ ; IHS/SD/TPF - TRANSACTION/ADJUSTMENT REPORT ; 08/20/2008

 ;;1.8;IHS ACCOUNTS RECEIVABLE;**6,7,19,20,24**;OCT 26, 2005;Build 69

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

 ;IHS/SD/POT 01/15/14 HEAT124730 ADDING DOS TO TEXT DELIM REPORT ;BAR*1.8*24

 ;

 Q

EN ; EP

 K BARY,BAR

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

 S BARP("RTN")="BARRADJ"  ;Rtn 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  ;excl. parms

 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

 ;IHS/SD/AR bar*1.8*19 RQMNT

 N BARTEXT

 K DIR

 S DIR("A")="Text-delimited? "

 S DIR(0)="Y;;"

 S DIR("B")="N"

 D ^DIR

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

 S BARTEXT=Y

 ;IHS/SD/AR bar*1.8*19 RQMNT

 D ^BARRHD  ;Rpt hdr

 S %ZIS="Q"

 D ^%ZIS

 G:POP EN

 I $G(IO("Q")) D QUE Q

 U IO ;:140 ;4/1/2014

 D COMPUTE

 D ^%ZISC

 ;Q:$G(BAR("F1"))  ;bar*1.8*19*DEL*TMM

 I $G(BAR("F1")) G CLEANUP Q  ;bar*1.8*19*ADD*TMM

 D CLEANUP  ;bar*1.8*19*ADD*TMM

 I IOST'[("P-") D PAZ^BARRUTL

 Q

QUE ;EP

 K IO("Q")

 S ZTRTN="COMPUTE^BARRADJ",ZTDESC="Transaction/Adjustment Report"

 S ZTSAVE("BAR*")=""

 D ^%ZTLOAD

 I $D(ZTSK)[0 W !!?5,"REPORT CANCELLED!"

 E  W !!?5,"REQUEST QUEUED AS TASK # "_ZTSK_" !",!

 Q

COMPUTE ;

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

 ;IHS/SD/AR 1.8*19 - moved K ^TMP to loop

 ;I $D(BARY("TRANS TYPE",43)) D  ;bar*1.8*19*DEL*TMM

 I $D(BARY("TRANS TYPE",43))!$D(BARY("TRANS TYPE",993)) D  ;bar*1.8*19*ADD*TMM

 . ;IHS/SD/POT BAR*1.8*24

 . ;W:(BARTEXT)&(BARY("SORT")'="N") "LOCATION^CL/VI^ADJ CATEGORY^BILL NUMBER^TRXN DATE^INSURER^BILL AMOUNT^TRXN AMOUNT^ADJ TYPE"

 . ;W:(BARTEXT)&(BARY("SORT")="N") "LOCATION^ADJ CATEGORY^BILL NUMBER^TRXN DATE^INSURER^BILL AMOUNT^TRXN AMOUNT^ADJ TYPE"

 . W:(BARTEXT)&(BARY("SORT")'="N") "LOCATION^CL/VI^ADJ CATEGORY^BILL NUMBER^DOS^TRXN DATE^INSURER^BILL AMOUNT^TRXN AMOUNT^ADJ TYPE"

 . W:(BARTEXT)&(BARY("SORT")="N") "LOCATION^ADJ CATEGORY^BILL NUMBER^DOS^TRXN DATE^INSURER^BILL AMOUNT^TRXN AMOUNT^ADJ TYPE"

 E  D

 . ;IHS/SD/POT BAR*1.8*24

 . ;W:(BARTEXT)&(BARY("SORT")'="N") "LOCATION^CL/VI^BILL NUMBER^TRXN DATE^INSURER^BILL AMOUNT^TRXN AMOUNT"

 . ;W:(BARTEXT)&(BARY("SORT")="N") "LOCATION^BILL NUMBER^TRXN DATE^INSURER^BILL AMOUNT^TRXN AMOUNT"

 . W:(BARTEXT)&(BARY("SORT")'="N") "LOCATION^CL/VI^BILL NUMBER^DOS^TRXN DATE^INSURER^BILL AMOUNT^TRXN AMOUNT"

 . W:(BARTEXT)&(BARY("SORT")="N") "LOCATION^BILL NUMBER^DOS^TRXN DATE^INSURER^BILL AMOUNT^TRXN AMOUNT"

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

 S BARDUZ2=DUZ(2)

 S DUZ(2)=0

 ;IHS/SD/AR 1.8*19

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

 F  S DUZ(2)=$O(^BARTR(DUZ(2))) Q:'DUZ(2)!$G(BAR("F1"))  D

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

 .K ^TMP($J,"BAR-TSR")

 .K ^TMP($J,"BAR-TSRS")

 .K ^TMP($J,"BAR-TSRS-INS")

 .D TRANS^BARRUTL

 .D PRINT

 S DUZ(2)=BARDUZ2

 Q

DATA ; EP

 ; Called by BARRUTL if no parms

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

 S BARP("HIT")=0

 D TRANS^BARRCHK  ;FIND TRANS THAT MATCH CRITERIA

 Q:'BARP("HIT")

 ;IHS/SD/AR 1.8*19 RQMNT

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

 S BAR("SORT")=$S(BARY("SORT")="C":BAR("C"),BARY("SORT")="N":"N",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)  ;Trans type

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

 S BAR("ADJTYPE")=$P(BARTR(1),U,3)  ;Adj Type

 S BAR("BILL")=$$GET1^DIQ(90050.03,BARTR_",",4,"I")  ;A/R BILL IEN

 S BAR("V TYPE")=$$GET1^DIQ(90050.01,BAR("BILL")_",",4,"I")  ;VISIT TYPE

 S:BAR("V TYPE")="" BAR("V TYPE")="UNDEF"

 ;If the ADJ CATEGORY is not a

 ;3  = WRITE OFF

 ;4  = NON PYMT

 ;13 = DEDUCTIBLE

 ;14 = CO-PAY

 ;15 = PENALTY

 ;16 = GROUPER ALLOWANCE

 ;19 = REFUND

 ;20 = PYMT CREDIT

 ;and

 ;the TRANS TYPE is not a

 ;40  = PYMT

 ;100 = UNALLOCATED

 ;THEN QUI

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

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

 F X=1:1:7 S BAR(X)=0  ;RESET AMTS

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

 S:BAR("TRANS")=40 BAR(2)=BAR("CR-DB")  ;Pymt Amt

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

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

 S:BAR("ADJCAT")="" BAR("ADJCAT")="UNDEF"

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

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

 ;Adjs

 ;I ",3,4,13,14,15,16,"[(","_BAR("ADJCAT")_",") S BAR(7)=BAR("CR-DB")  ;bar*1.8*19*DEL*TMM

 I ",3,4,13,14,15,16,25,"[(","_BAR("ADJCAT")_",") S BAR(7)=BAR("CR-DB")  ;bar*1.8*19*ADD*TMM

 ;For detail

 ;SORT ORDER

 ;BARTR("AR") = (#13) ENTRY BY from A/R TRANS

 ;DUZ(2)      = FACILITY

 ;BARTR("L")  = (#108) VISIT LOCATION from A/R BILL

 ;BARTR("B")  =(#14) COLLECTION BATCH from A/R TRANS

 ;BARTR("IT") = (#15) COLLECTION ITEM from A/R TRANS

 ;BAR("SORT") = SORT BY CLINIC OR VISIT

 ;BAR("ACCT") = (#3) A/R ACCT from A/R BILL

 ;BAR         = A/R BILL IEN

 ;THE REPORT IS SET UP TO INCLUDE ONLY PYMTS OR ONLY ADJS

 ;IF THE TRANS TYPE IS PYMT WE WILL SORT BY TRANS TYPE THEN ADJ CATEGORY

 ;OTHERWISE WE WILL SORT BY ADJ CATEGORY THEN ADJ TYPE

 I BAR("TRANS")'=40 D

 .S BAR("TRANS")=$S($G(BAR("ADJCAT"))'="":BAR("ADJCAT"),1:"NO SELECTION")

 .;IHS/SD/AR bar*1.8*19 RQMNT

 .;S BAR("ADJCAT")=$S($G(BAR("ADJTYP"))'="":BAR("ADJTYP"),1:"NO SELECTION")

 .S BAR("ADJCAT")=$S($G(BAR("ADJTYPE"))'="":BAR("ADJTYPE"),1:"NO SELECTION")

 ;start old bar*1.8*20 REQ10

 ;S BARHLD=$G(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BAR("SORT")_U_BAR_U_BARTR))

 ;S $P(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BAR("SORT")_U_BAR_U_BARTR),U)=BAR(1)

 ;S $P(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BAR("SORT")_U_BAR_U_BARTR),U,2)=$P(BARHLD,U,2)+BAR(2)

 ;S $P(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BAR("SORT")_U_BAR_U_BARTR),U,3)=$P(BARHLD,U,3)+BAR(3)

 ;S $P(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BAR("SORT")_U_BAR_U_BARTR),U,4)=$P(BARHLD,U,4)+BAR(4)

 ;S $P(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BAR("SORT")_U_BAR_U_BARTR),U,5)=$P(BARHLD,U,5)+BAR(5)

 ;S $P(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BAR("SORT")_U_BAR_U_BARTR),U,6)=BAR(6)

 ;S $P(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BAR("SORT")_U_BAR_U_BARTR),U,7)=$P(BARHLD,U,7)+BAR(7)

 ;S $P(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BAR("SORT")_U_BAR_U_BARTR),U,8)=$$GET1^DIQ(90052.02,BARTR("T")_",",.01,"E")

 ;S $P(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BAR("SORT")_U_BAR_U_BARTR),U,9)=$$GET1^DIQ(90050.02,BARTR("I")_",",.01,"E")

 ;S $P(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BAR("SORT")_U_BAR_U_BARTR),U,10)=$$SDT^BARDUTL($P(BARTR("DT"),"."))

 ;S $P(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BAR("SORT")_U_BAR_U_BARTR),U,11)=BARTR("I")

 ;S $P(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BAR("SORT")_U_BAR_U_BARTR),U,11)=BAR("ADJCAT")

 ;S $P(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BAR("SORT")_U_BAR_U_BARTR),U,12)=BAR("ADJTYPE")

 ; For summary

 ;S BARHLD2=$G(^TMP($J,"BAR-TSRS",BARTR("AR"),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BAR("SORT")))

 ;S ^TMP($J,"BAR-TSRS-INS",BARTR("AR")_U_DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BAR("SORT"),BARTR("I"),BAR)=$G(^TMP($J,"BAR-TSR-INS",BARTR("AR")_U_DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BAR("SORT"),BARTR("I"),BAR))+1

 ;S ^TMP($J,"BAR-TSRS-INS",BARTR("AR"),DUZ(2),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BAR("SORT"),BARTR("I"),BAR)=$G(^TMP($J,"BAR-TSR-INS",BARTR("AR"),DUZ(2),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BAR("SORT"),BARTR("I"),BAR))+1

 ;S $P(^TMP($J,"BAR-TSRS",BARTR("AR"),DUZ(2),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BAR("SORT")),U,2)=$P(BARHLD2,U,2)+BAR(2)

 ;S $P(^TMP($J,"BAR-TSRS",BARTR("AR"),DUZ(2),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BAR("SORT")),U,3)=$P(BARHLD2,U,3)+BAR(3)

 ;S $P(^TMP($J,"BAR-TSRS",BARTR("AR"),DUZ(2),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BAR("SORT")),U,4)=$P(BARHLD2,U,4)+BAR(4)

 ;S $P(^TMP($J,"BAR-TSRS",BARTR("AR"),DUZ(2),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BAR("SORT")),U,5)=$P(BARHLD2,U,5)+BAR(5)

 ;S $P(^TMP($J,"BAR-TSRS",BARTR("AR"),DUZ(2),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BAR("SORT")),U,6)=$P(BARHLD2,U,6)+BAR(6)

 ;S $P(^TMP($J,"BAR-TSRS",BARTR("AR"),DUZ(2),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BAR("SORT")),U,7)=$P(BARHLD2,U,7)+BAR(7)

 ;S $P(^TMP($J,"BAR-TSRS",BARTR("AR"),DUZ(2),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BAR("SORT")),U,9)=$$GET1^DIQ(90050.02,BARTR("I")_",",.01,"E")

 ;S $P(^TMP($J,"BAR-TSRS",BARTR("AR"),DUZ(2),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BAR("SORT")),U,10)=$$SDT^BARDUTL($P(BARTR("DT"),"."))

 ;end old start new REQ10

 S BARHLD=$G(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BARTR("DATA SRC")_U_BAR("SORT")_U_BAR_U_BARTR))

 S $P(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BARTR("DATA SRC")_U_BAR("SORT")_U_BAR_U_BARTR),U)=BAR(1)

 S $P(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BARTR("DATA SRC")_U_BAR("SORT")_U_BAR_U_BARTR),U,2)=$P(BARHLD,U,2)+BAR(2)

 S $P(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BARTR("DATA SRC")_U_BAR("SORT")_U_BAR_U_BARTR),U,3)=$P(BARHLD,U,3)+BAR(3)

 S $P(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BARTR("DATA SRC")_U_BAR("SORT")_U_BAR_U_BARTR),U,4)=$P(BARHLD,U,4)+BAR(4)

 S $P(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BARTR("DATA SRC")_U_BAR("SORT")_U_BAR_U_BARTR),U,5)=$P(BARHLD,U,5)+BAR(5)

 ;

 S $P(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BARTR("DATA SRC")_U_BAR("SORT")_U_BAR_U_BARTR),U,6)=BAR(6)

 S $P(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BARTR("DATA SRC")_U_BAR("SORT")_U_BAR_U_BARTR),U,7)=$P(BARHLD,U,7)+BAR(7)

 S $P(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BARTR("DATA SRC")_U_BAR("SORT")_U_BAR_U_BARTR),U,8)=$$GET1^DIQ(90052.02,BARTR("T")_",",.01,"E")

 S $P(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BARTR("DATA SRC")_U_BAR("SORT")_U_BAR_U_BARTR),U,9)=$$GET1^DIQ(90050.02,BARTR("I")_",",.01,"E")

 S $P(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BARTR("DATA SRC")_U_BAR("SORT")_U_BAR_U_BARTR),U,10)=$$SDT^BARDUTL($P(BARTR("DT"),"."))

 S $P(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BARTR("DATA SRC")_U_BAR("SORT")_U_BAR_U_BARTR),U,11)=BARTR("I")

 S $P(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BARTR("DATA SRC")_U_BAR("SORT")_U_BAR_U_BARTR),U,11)=BAR("ADJCAT")

 S $P(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BARTR("DATA SRC")_U_BAR("SORT")_U_BAR_U_BARTR),U,12)=BAR("ADJTYPE")

 ; For summary

 S BARHLD2=$G(^TMP($J,"BAR-TSRS",BARTR("AR"),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BARTR("DATA SRC"),BAR("SORT")))

 S BARTMP=$G(^TMP($J,"BAR-TSR-INS",BARTR("AR")_U_DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BARTR("DATA SRC")_U_BAR("SORT"),BARTR("I"),BAR))+1

 S ^TMP($J,"BAR-TSRS-INS",BARTR("AR")_U_DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BARTR("DATA SRC")_U_BAR("SORT"),BARTR("I"),BAR)=BARTMP

 S BARTMP=$G(^TMP($J,"BAR-TSR-INS",BARTR("AR"),DUZ(2),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BARTR("DATA SRC"),BAR("SORT"),BARTR("I"),BAR))+1

 S ^TMP($J,"BAR-TSRS-INS",BARTR("AR"),DUZ(2),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BARTR("DATA SRC"),BAR("SORT"),BARTR("I"),BAR)=BARTMP

 S $P(^TMP($J,"BAR-TSRS",BARTR("AR"),DUZ(2),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BARTR("DATA SRC"),BAR("SORT")),U,2)=$P(BARHLD2,U,2)+BAR(2)

 S $P(^TMP($J,"BAR-TSRS",BARTR("AR"),DUZ(2),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BARTR("DATA SRC"),BAR("SORT")),U,3)=$P(BARHLD2,U,3)+BAR(3)

 S $P(^TMP($J,"BAR-TSRS",BARTR("AR"),DUZ(2),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BARTR("DATA SRC"),BAR("SORT")),U,4)=$P(BARHLD2,U,4)+BAR(4)

 S $P(^TMP($J,"BAR-TSRS",BARTR("AR"),DUZ(2),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BARTR("DATA SRC"),BAR("SORT")),U,5)=$P(BARHLD2,U,5)+BAR(5)

 S $P(^TMP($J,"BAR-TSRS",BARTR("AR"),DUZ(2),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BARTR("DATA SRC"),BAR("SORT")),U,6)=$P(BARHLD2,U,6)+BAR(6)

 S $P(^TMP($J,"BAR-TSRS",BARTR("AR"),DUZ(2),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BARTR("DATA SRC"),BAR("SORT")),U,7)=$P(BARHLD2,U,7)+BAR(7)

 S $P(^TMP($J,"BAR-TSRS",BARTR("AR"),DUZ(2),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BARTR("DATA SRC"),BAR("SORT")),U,9)=$$GET1^DIQ(90050.02,BARTR("I")_",",.01,"E")

 S $P(^TMP($J,"BAR-TSRS",BARTR("AR"),DUZ(2),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BARTR("DATA SRC"),BAR("SORT")),U,10)=$$SDT^BARDUTL($P(BARTR("DT"),"."))

 ;end new REQ10

 Q

PRINT ; EP

 ; Print

 S BAR("PG")=0

 ;IHS/SD/AR 1.8*19 RQMNT

 I BARTEXT D

 .S SUMMARY=0

 .D DETAIL^BARRADJ2

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

 .S SUMMARY=1

 E  D

 .I BARY("RTYP")=1 S SUMMARY=0 D DETAIL^BARRADJ2,FOOTER

 .I BARY("RTYP")=2 S SUMMARY=1 D DETAIL^BARRADJ2,FOOTER

 .I BARY("RTYP")=3 D

 ..S SUMMARY=0

 ..D DETAIL^BARRADJ2

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

 ..D PAZ^BARRUTL

 ..I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S BAR("F1")=1  ;bar*1.8*19*ADD*TMM

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

 ..S SUMMARY=1  ;SET SUMMARY FLAG

 ..D DETAIL^BARRADJ2

 ..D FOOTER

 Q

FOOTER ;CODE SPLIT BAR*1.8*24

 D FOOTER^BARRADJ0

 Q

 ;below tag new in bar*1.8*19

CLEANUP ;  Cleanup TSR vars

 D CLEANUP^BARRADJ0 ;BAR*1.8*24 CODE SPLIT

 Q

BARRADJ   ; IHS/SD/TPF - TRANSACTION/ADJUSTMENT REPORT ; 08/20/2008

 +1       ;;1.8;IHS ACCOUNTS RECEIVABLE;**6,7,19,20,24**;OCT 26, 2005;Build 69

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

 +3       ;IHS/SD/POT 01/15/14 HEAT124730 ADDING DOS TO TEXT DELIM REPORT ;BAR*1.8*24

 +4       ;

 +5        QUIT 

EN        ; EP

 +1        KILL BARY,BAR

 +2       ;Setup basic A/R vars

           IF '$DATA(BARUSR)

               DO INIT^BARUTL

 +3       ;Rtn used to get data

           SET BARP("RTN")="BARRADJ"

 +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       ;excl. parms

           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      ;IHS/SD/AR bar*1.8*19 RQMNT

 +12       NEW BARTEXT

 +13       KILL DIR

 +14       SET DIR("A")="Text-delimited? "

 +15       SET DIR(0)="Y;;"

 +16       SET DIR("B")="N"

 +17       DO ^DIR

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

               QUIT 

 +19       SET BARTEXT=Y

 +20      ;IHS/SD/AR bar*1.8*19 RQMNT

 +21      ;Rpt hdr

           DO ^BARRHD

 +22       SET %ZIS="Q"

 +23       DO ^%ZIS

 +24       IF POP

               GOTO EN

 +25       IF $GET(IO("Q"))

               DO QUE

               QUIT 

 +26      ;:140 ;4/1/2014

           USE IO

 +27       DO COMPUTE

 +28       DO ^%ZISC

 +29      ;Q:$G(BAR("F1"))  ;bar*1.8*19*DEL*TMM

 +30      ;bar*1.8*19*ADD*TMM

           IF $GET(BAR("F1"))

               GOTO CLEANUP

               QUIT 

 +31      ;bar*1.8*19*ADD*TMM

           DO CLEANUP

 +32       IF IOST'[("P-")

               DO PAZ^BARRUTL

 +33       QUIT 

QUE       ;EP

 +1        KILL IO("Q")

 +2        SET ZTRTN="COMPUTE^BARRADJ"

           SET ZTDESC="Transaction/Adjustment Report"

 +3        SET ZTSAVE("BAR*")=""

 +4        DO ^%ZTLOAD

 +5        IF $DATA(ZTSK)[0

               WRITE !!?5,"REPORT CANCELLED!"

 +6       IF '$TEST

               WRITE !!?5,"REQUEST QUEUED AS TASK # "_ZTSK_" !",!

 +7        QUIT 

COMPUTE   ;

 +1        SET BAR("SUBR")="BAR-TSR"

 +2       ;IHS/SD/AR 1.8*19 - moved K ^TMP to loop

 +3       ;I $D(BARY("TRANS TYPE",43)) D  ;bar*1.8*19*DEL*TMM

 +4       ;bar*1.8*19*ADD*TMM

           IF $DATA(BARY("TRANS TYPE",43))!$DATA(BARY("TRANS TYPE",993))

               Begin DoDot:1

 +5       ;IHS/SD/POT BAR*1.8*24

 +6       ;W:(BARTEXT)&(BARY("SORT")'="N") "LOCATION^CL/VI^ADJ CATEGORY^BILL NUMBER^TRXN DATE^INSURER^BILL AMOUNT^TRXN AMOUNT^ADJ TYPE"

 +7       ;W:(BARTEXT)&(BARY("SORT")="N") "LOCATION^ADJ CATEGORY^BILL NUMBER^TRXN DATE^INSURER^BILL AMOUNT^TRXN AMOUNT^ADJ TYPE"

 +8                IF (BARTEXT)&(BARY("SORT")'="N")

                       WRITE "LOCATION^CL/VI^ADJ CATEGORY^BILL NUMBER^DOS^TRXN DATE^INSURER^BILL AMOUNT^TRXN AMOUNT^ADJ TYPE"

 +9                IF (BARTEXT)&(BARY("SORT")="N")

                       WRITE "LOCATION^ADJ CATEGORY^BILL NUMBER^DOS^TRXN DATE^INSURER^BILL AMOUNT^TRXN AMOUNT^ADJ TYPE"

               End DoDot:1

 +10      IF '$TEST

               Begin DoDot:1

 +11      ;IHS/SD/POT BAR*1.8*24

 +12      ;W:(BARTEXT)&(BARY("SORT")'="N") "LOCATION^CL/VI^BILL NUMBER^TRXN DATE^INSURER^BILL AMOUNT^TRXN AMOUNT"

 +13      ;W:(BARTEXT)&(BARY("SORT")="N") "LOCATION^BILL NUMBER^TRXN DATE^INSURER^BILL AMOUNT^TRXN AMOUNT"

 +14               IF (BARTEXT)&(BARY("SORT")'="N")

                       WRITE "LOCATION^CL/VI^BILL NUMBER^DOS^TRXN DATE^INSURER^BILL AMOUNT^TRXN AMOUNT"

 +15               IF (BARTEXT)&(BARY("SORT")="N")

                       WRITE "LOCATION^BILL NUMBER^DOS^TRXN DATE^INSURER^BILL AMOUNT^TRXN AMOUNT"

               End DoDot:1

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

               DO TRANS^BARRUTL

               DO PRINT

               QUIT 

 +17       SET BARDUZ2=DUZ(2)

 +18       SET DUZ(2)=0

 +19      ;IHS/SD/AR 1.8*19

 +20      ;F  S DUZ(2)=$O(^BARTR(DUZ(2))) Q:'DUZ(2)  D TRANS^BARRUTL,PRINT

 +21       FOR 

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

               IF 'DUZ(2)!$GET(BAR("F1"))

                   QUIT 

               Begin DoDot:1

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

                       QUIT 

 +23               KILL ^TMP($JOB,"BAR-TSR")

 +24               KILL ^TMP($JOB,"BAR-TSRS")

 +25               KILL ^TMP($JOB,"BAR-TSRS-INS")

 +26               DO TRANS^BARRUTL

 +27               DO PRINT

               End DoDot:1

 +28       SET DUZ(2)=BARDUZ2

 +29       QUIT 

DATA      ; EP

 +1       ; Called by BARRUTL if no parms

 +2        FOR I=2:1:7

               SET BAR(I)=0

 +3        SET BARP("HIT")=0

 +4       ;FIND TRANS THAT MATCH CRITERIA

           DO TRANS^BARRCHK

 +5        IF 'BARP("HIT")

               QUIT 

 +6       ;IHS/SD/AR 1.8*19 RQMNT

 +7       ;S BAR("SORT")=$S(BARY("SORT")="C":BAR("C"),BARY1:BAR("V"))

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

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

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

 +10      ;External A/R Acct

           IF BAR("ACCT")=""

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

 +11      ;External location

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

 +12      ;Trans type

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

 +13      ;Adj Category

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

 +14      ;Adj Type

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

 +15      ;A/R BILL IEN

           SET BAR("BILL")=$$GET1^DIQ(90050.03,BARTR_",",4,"I")

 +16      ;VISIT TYPE

           SET BAR("V TYPE")=$$GET1^DIQ(90050.01,BAR("BILL")_",",4,"I")

 +17       IF BAR("V TYPE")=""

               SET BAR("V TYPE")="UNDEF"

 +18      ;If the ADJ CATEGORY is not a

 +19      ;3  = WRITE OFF

 +20      ;4  = NON PYMT

 +21      ;13 = DEDUCTIBLE

 +22      ;14 = CO-PAY

 +23      ;15 = PENALTY

 +24      ;16 = GROUPER ALLOWANCE

 +25      ;19 = REFUND

 +26      ;20 = PYMT CREDIT

 +27      ;and

 +28      ;the TRANS TYPE is not a

 +29      ;40  = PYMT

 +30      ;100 = UNALLOCATED

 +31      ;THEN QUI

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

 +33      ;Credits - Debits

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

 +34      ;RESET AMTS

           FOR X=1:1:7

               SET BAR(X)=0

 +35      ;Bill#

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

 +36      ;Pymt Amt

           IF BAR("TRANS")=40

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

 +37      ;Prev. credits

           IF BAR("ADJCAT")=20

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

 +38      ;Rfnd

           IF BAR("ADJCAT")=19

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

 +39       IF BAR("ADJCAT")=""

               SET BAR("ADJCAT")="UNDEF"

 +40      ;Pymt

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

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

 +41      ;Billed Amt

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

 +42      ;Adjs

 +43      ;I ",3,4,13,14,15,16,"[(","_BAR("ADJCAT")_",") S BAR(7)=BAR("CR-DB")  ;bar*1.8*19*DEL*TMM

 +44      ;bar*1.8*19*ADD*TMM

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

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

 +45      ;For detail

 +46      ;SORT ORDER

 +47      ;BARTR("AR") = (#13) ENTRY BY from A/R TRANS

 +48      ;DUZ(2)      = FACILITY

 +49      ;BARTR("L")  = (#108) VISIT LOCATION from A/R BILL

 +50      ;BARTR("B")  =(#14) COLLECTION BATCH from A/R TRANS

 +51      ;BARTR("IT") = (#15) COLLECTION ITEM from A/R TRANS

 +52      ;BAR("SORT") = SORT BY CLINIC OR VISIT

 +53      ;BAR("ACCT") = (#3) A/R ACCT from A/R BILL

 +54      ;BAR         = A/R BILL IEN

 +55      ;THE REPORT IS SET UP TO INCLUDE ONLY PYMTS OR ONLY ADJS

 +56      ;IF THE TRANS TYPE IS PYMT WE WILL SORT BY TRANS TYPE THEN ADJ CATEGORY

 +57      ;OTHERWISE WE WILL SORT BY ADJ CATEGORY THEN ADJ TYPE

 +58       IF BAR("TRANS")'=40

               Begin DoDot:1

 +59               SET BAR("TRANS")=$SELECT($GET(BAR("ADJCAT"))'="":BAR("ADJCAT"),1:"NO SELECTION")

 +60      ;IHS/SD/AR bar*1.8*19 RQMNT

 +61      ;S BAR("ADJCAT")=$S($G(BAR("ADJTYP"))'="":BAR("ADJTYP"),1:"NO SELECTION")

 +62               SET BAR("ADJCAT")=$SELECT($GET(BAR("ADJTYPE"))'="":BAR("ADJTYPE"),1:"NO SELECTION")

               End DoDot:1

 +63      ;start old bar*1.8*20 REQ10

 +64      ;S BARHLD=$G(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BAR("SORT")_U_BAR_U_BARTR))

 +65      ;S $P(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BAR("SORT")_U_BAR_U_BARTR),U)=BAR(1)

 +66      ;S $P(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BAR("SORT")_U_BAR_U_BARTR),U,2)=$P(BARHLD,U,2)+BAR(2)

 +67      ;S $P(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BAR("SORT")_U_BAR_U_BARTR),U,3)=$P(BARHLD,U,3)+BAR(3)

 +68      ;S $P(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BAR("SORT")_U_BAR_U_BARTR),U,4)=$P(BARHLD,U,4)+BAR(4)

 +69      ;S $P(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BAR("SORT")_U_BAR_U_BARTR),U,5)=$P(BARHLD,U,5)+BAR(5)

 +70      ;S $P(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BAR("SORT")_U_BAR_U_BARTR),U,6)=BAR(6)

 +71      ;S $P(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BAR("SORT")_U_BAR_U_BARTR),U,7)=$P(BARHLD,U,7)+BAR(7)

 +72      ;S $P(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BAR("SORT")_U_BAR_U_BARTR),U,8)=$$GET1^DIQ(90052.02,BARTR("T")_",",.01,"E")

 +73      ;S $P(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BAR("SORT")_U_BAR_U_BARTR),U,9)=$$GET1^DIQ(90050.02,BARTR("I")_",",.01,"E")

 +74      ;S $P(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BAR("SORT")_U_BAR_U_BARTR),U,10)=$$SDT^BARDUTL($P(BARTR("DT"),"."))

 +75      ;S $P(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BAR("SORT")_U_BAR_U_BARTR),U,11)=BARTR("I")

 +76      ;S $P(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BAR("SORT")_U_BAR_U_BARTR),U,11)=BAR("ADJCAT")

 +77      ;S $P(^TMP($J,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BAR("SORT")_U_BAR_U_BARTR),U,12)=BAR("ADJTYPE")

 +78      ; For summary

 +79      ;S BARHLD2=$G(^TMP($J,"BAR-TSRS",BARTR("AR"),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BAR("SORT")))

 +80      ;S ^TMP($J,"BAR-TSRS-INS",BARTR("AR")_U_DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BAR("SORT"),BARTR("I"),BAR)=$G(^TMP($J,"BAR-TSR-INS",BARTR("AR")_U_DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BAR("SORT"),BARTR("I"),BAR))+1

 +81      ;S ^TMP($J,"BAR-TSRS-INS",BARTR("AR"),DUZ(2),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BAR("SORT"),BARTR("I"),BAR)=$G(^TMP($J,"BAR-TSR-INS",BARTR("AR"),DUZ(2),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BAR("SORT"),BARTR("I"),BAR))+1

 +82      ;S $P(^TMP($J,"BAR-TSRS",BARTR("AR"),DUZ(2),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BAR("SORT")),U,2)=$P(BARHLD2,U,2)+BAR(2)

 +83      ;S $P(^TMP($J,"BAR-TSRS",BARTR("AR"),DUZ(2),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BAR("SORT")),U,3)=$P(BARHLD2,U,3)+BAR(3)

 +84      ;S $P(^TMP($J,"BAR-TSRS",BARTR("AR"),DUZ(2),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BAR("SORT")),U,4)=$P(BARHLD2,U,4)+BAR(4)

 +85      ;S $P(^TMP($J,"BAR-TSRS",BARTR("AR"),DUZ(2),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BAR("SORT")),U,5)=$P(BARHLD2,U,5)+BAR(5)

 +86      ;S $P(^TMP($J,"BAR-TSRS",BARTR("AR"),DUZ(2),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BAR("SORT")),U,6)=$P(BARHLD2,U,6)+BAR(6)

 +87      ;S $P(^TMP($J,"BAR-TSRS",BARTR("AR"),DUZ(2),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BAR("SORT")),U,7)=$P(BARHLD2,U,7)+BAR(7)

 +88      ;S $P(^TMP($J,"BAR-TSRS",BARTR("AR"),DUZ(2),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BAR("SORT")),U,9)=$$GET1^DIQ(90050.02,BARTR("I")_",",.01,"E")

 +89      ;S $P(^TMP($J,"BAR-TSRS",BARTR("AR"),DUZ(2),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BAR("SORT")),U,10)=$$SDT^BARDUTL($P(BARTR("DT"),"."))

 +90      ;end old start new REQ10

 +91       SET BARHLD=$GET(^TMP($JOB,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BARTR("DATA SRC")_U_BAR("SORT")_U_BAR_U_BARTR))

 +92       SET $PIECE(^TMP($JOB,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BARTR("DATA SRC")_U_BAR("SORT")_U_BAR_U_BARTR),U)=BAR(1)

 +93       SET $PIECE(^TMP($JOB,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BARTR("DATA SRC")_U_BAR("SORT")_U_BAR_U_BARTR),U,2)=$PIECE(BARHLD,U,2)+BAR(2)

 +94       SET $PIECE(^TMP($JOB,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BARTR("DATA SRC")_U_BAR("SORT")_U_BAR_U_BARTR),U,3)=$PIECE(BARHLD,U,3)+BAR(3)

 +95       SET $PIECE(^TMP($JOB,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BARTR("DATA SRC")_U_BAR("SORT")_U_BAR_U_BARTR),U,4)=$PIECE(BARHLD,U,4)+BAR(4)

 +96       SET $PIECE(^TMP($JOB,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BARTR("DATA SRC")_U_BAR("SORT")_U_BAR_U_BARTR),U,5)=$PIECE(BARHLD,U,5)+BAR(5)

 +97      ;

 +98       SET $PIECE(^TMP($JOB,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BARTR("DATA SRC")_U_BAR("SORT")_U_BAR_U_BARTR),U,6)=BAR(6)

 +99       SET $PIECE(^TMP($JOB,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BARTR("DATA SRC")_U_BAR("SORT")_U_BAR_U_BARTR),U,7)=$PIECE(BARHLD,U,7)+BAR(7)

 +100      SET $PIECE(^TMP($JOB,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BARTR("DATA SRC")_U_BAR("SORT")_U_BAR_U_BARTR),U,8)=$$GET1^DIQ(90052.02,BARTR("T")_",",.01,"E")

 +101      SET $PIECE(^TMP($JOB,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BARTR("DATA SRC")_U_BAR("SORT")_U_BAR_U_BARTR),U,9)=$$GET1^DIQ(90050.02,BARTR("I")_",",.01,"E")

 +102      SET $PIECE(^TMP($JOB,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BARTR("DATA SRC")_U_BAR("SORT")_U_BAR_U_BARTR),U,10)=$$SDT^BARDUTL($PIECE(BARTR("DT"),"."))

 +103      SET $PIECE(^TMP($JOB,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BARTR("DATA SRC")_U_BAR("SORT")_U_BAR_U_BARTR),U,11)=BARTR("I")

 +104      SET $PIECE(^TMP($JOB,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BARTR("DATA SRC")_U_BAR("SORT")_U_BAR_U_BARTR),U,11)=BAR("ADJCAT")

 +105      SET $PIECE(^TMP($JOB,"BAR-TSR",BARTR("AR"),DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BARTR("DATA SRC")_U_BAR("SORT")_U_BAR_U_BARTR),U,12)=BAR("ADJTYPE")

 +106     ; For summary

 +107      SET BARHLD2=$GET(^TMP($JOB,"BAR-TSRS",BARTR("AR"),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BARTR("DATA SRC"),BAR("SORT")))

 +108      SET BARTMP=$GET(^TMP($JOB,"BAR-TSR-INS",BARTR("AR")_U_DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BARTR("DATA SRC")_U_BAR("SORT"),BARTR("I"),BAR))+1

 +109      SET ^TMP($JOB,"BAR-TSRS-INS",BARTR("AR")_U_DUZ(2)_U_BARTR("L")_U_BAR("TRANS")_U_BAR("ADJCAT")_U_BARTR("DATA SRC")_U_BAR("SORT"),BARTR("I"),BAR)=BARTMP

 +110      SET BARTMP=$GET(^TMP($JOB,"BAR-TSR-INS",BARTR("AR"),DUZ(2),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BARTR("DATA SRC"),BAR("SORT"),BARTR("I"),BAR))+1

 +111      SET ^TMP($JOB,"BAR-TSRS-INS",BARTR("AR"),DUZ(2),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BARTR("DATA SRC"),BAR("SORT"),BARTR("I"),BAR)=BARTMP

 +112      SET $PIECE(^TMP($JOB,"BAR-TSRS",BARTR("AR"),DUZ(2),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BARTR("DATA SRC"),BAR("SORT")),U,2)=$PIECE(BARHLD2,U,2)+BAR(2)

 +113      SET $PIECE(^TMP($JOB,"BAR-TSRS",BARTR("AR"),DUZ(2),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BARTR("DATA SRC"),BAR("SORT")),U,3)=$PIECE(BARHLD2,U,3)+BAR(3)

 +114      SET $PIECE(^TMP($JOB,"BAR-TSRS",BARTR("AR"),DUZ(2),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BARTR("DATA SRC"),BAR("SORT")),U,4)=$PIECE(BARHLD2,U,4)+BAR(4)

 +115      SET $PIECE(^TMP($JOB,"BAR-TSRS",BARTR("AR"),DUZ(2),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BARTR("DATA SRC"),BAR("SORT")),U,5)=$PIECE(BARHLD2,U,5)+BAR(5)

 +116      SET $PIECE(^TMP($JOB,"BAR-TSRS",BARTR("AR"),DUZ(2),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BARTR("DATA SRC"),BAR("SORT")),U,6)=$PIECE(BARHLD2,U,6)+BAR(6)

 +117      SET $PIECE(^TMP($JOB,"BAR-TSRS",BARTR("AR"),DUZ(2),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BARTR("DATA SRC"),BAR("SORT")),U,7)=$PIECE(BARHLD2,U,7)+BAR(7)

 +118      SET $PIECE(^TMP($JOB,"BAR-TSRS",BARTR("AR"),DUZ(2),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BARTR("DATA SRC"),BAR("SORT")),U,9)=$$GET1^DIQ(90050.02,BARTR("I")_",",.01,"E")

 +119      SET $PIECE(^TMP($JOB,"BAR-TSRS",BARTR("AR"),DUZ(2),BARTR("L"),BAR("TRANS"),BAR("ADJCAT"),BARTR("DATA SRC"),BAR("SORT")),U,10)=$$SDT^BARDUTL($PIECE(BARTR("DT"),"."))

 +120     ;end new REQ10

 +121      QUIT 

PRINT     ; EP