BAREBCH ; IHS/SD/SDR - EDIT COLLECTION BATCH/ITEMS JAN 15,1997 ; 11/21/2008
;;1.8;IHS ACCOUNTS RECEIVABLE;**4,10,20,28**;OCT 26, 2005;Build 92
; New routine in bar*1.8*4 for DD item 4.1.5.2
;
;BAR*1.8*28 IHS/DIT/CPC - Added Edit Check Number CR5994
;BAR*1.8*28 IHS/DIT/CPC - Added Edit A/R Account CR5994
;BAR*1.8*28 IHS/DIT/CPC - Added Item Change Audit CR5994
;
EN ;EP;
K BARSTAR,BAREQUAL,BARDASH
K BARCBIEN,BARTRIEN,BARPFLG,BARVALUE
;K BARNBCH,BARNAMT ;IHS/SD/AML 5/3/2011 bar*1.8*20
K BARNBCH,BARNAMT,BARNDDT ;IHS/SD/AML 5/3/2011 bar*1.8*20
;
S $P(BARSTAR,"*",79)="*"
S $P(BAREQUAL,"=",79)="="
S $P(BARDASH,"-",79)="-"
;
W !!,$$EN^BARVDF("RVN"),"Note: ",$$EN^BARVDF("RVF")
W "Collection Batch and Items that have not been posted may be modified." ;IHS/DIT/CPC -20180425 Remove apostrophe BAR*1.8*28
W !?6,"If you entered a TDN/IPAC in error and the batch has been posted, you"
W !?6,"may not edit the TDN/IPAC and must notify your Finance Office to make"
W !?6,"adjustments in the financial system.",!!
;
SELECT ;
I $G(BARCBIEN)'="" D
.K BARCBIEN
.D CLEAR^VALM1
K DIC,DIE,X,Y,DA
S DIC="^BARCOL(DUZ(2),"
S DIC(0)="AEMQ"
D ^DIC
Q:$D(DTOUT)!$D(DUOUT)
Q:Y<0
S BARCBIEN=+Y
;
;check for payments posted to selected collection batch
S BARTRIEN=0
S BARPFLG=0
F S BARTRIEN=$O(^BARTR(DUZ(2),"AD",BARCBIEN,BARTRIEN)) Q:+BARTRIEN=0!(BARPFLG=1) D Q:BARPFLG=1
.I $P($G(^BARTR(DUZ(2),BARTRIEN,1)),U)=40 S BARPFLG=1
;
I BARPFLG=1 W !!,"ITEMS WITHIN THIS COLLECTION BATCH ALREADY HAVE PAYMENTS POSTED AND IS THEREFORE UNEDITABLE",!! H 2 K BARVALUE G SELECT
;no payments posted so display batch/item info and confirm entry
S BARCNT=0,BAREND=0,BARITEM=0 ;;IHS/DIT/CPC - 20180418 V1.8 P28 CHECK FOR NO ITEMS IN BATCH
F S BARITEM=$O(^BARCOL(DUZ(2),BARCBIEN,1,+BARITEM)) Q:+BARITEM=0 D
.S BARCNT=+$G(BARCNT)+1
I BARCNT=0 D
.S BAREND=1
.W !!,"There are no items associated with this batch.",!!
.W "Please use the Collections Entry option to add the",!
.W "missing batch item(s) before proceeding.",!!!
.S DIR(0)="E",DIR("A")="Enter RETURN to Continue"
.D ^DIR
.Q
I $G(BAREND) D CLEANUP Q ;IHS/DIT/CPC - 20180418 V1.8 P28 END NO ITEM CHECK
W !!!!
W BARSTAR
W !?2,"Collection Batch: ",$P($G(^BARCOL(DUZ(2),BARCBIEN,0)),U),!
W BARSTAR
W !?4,"TDN/IPAC: ",$P($G(^BARCOL(DUZ(2),BARCBIEN,0)),U,28)
W ?40,"TOTAL AMOUNT BATCHED: $",$FN($P($G(^BARCOL(DUZ(2),BARCBIEN,0)),U,29),",",2)
W !?2,"Batched by: ",$P($G(^VA(200,$P($G(^BARCOL(DUZ(2),BARCBIEN,0)),U,5),0)),U)
W ?48,"DATE CREATED: ",$$SDT^BARDUTL($P($G(^BARCOL(DUZ(2),BARCBIEN,0)),U,4))
W !,"DEPOSIT DATE: ",$$SDT^BARDUTL($P($G(^BARCOL(DUZ(2),BARCBIEN,0)),U,30)),!! ;IHS/SD/AML 5/3/2011 - ADD TDN/IPAC DEPOSIT DATE bar*1.8*20
W "Item",?9,"Check#",?27,"A/R ACCOUNT",?46,"TDN/IPAC",?69,"Amount"
W !
W BARDASH
S BARITEM=0
F S BARITEM=$O(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM)) Q:+BARITEM=0 D
.I $P($G(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,0)),U,17)'="",($P($G(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,0)),U,17)'="E") Q
.W !,$J(BARITEM,3) ;item number
.W ?5,$E($P($G(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,0)),U,11),1,20) ;item check#
.W ?27,$E($$GET1^DIQ(90051.1101,BARITEM_","_BARCBIEN_",",7,"E"),1,17) ;item A/R Acct
.W ?46,$P($G(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,0)),U,20) ;item TDN
.W ?68,$J($FN($P($G(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,1)),U),",",2),12) ;item amt
;
S DIR(0)="Y"
S DIR("A")="Correct"
S DIR("B")="Y"
D ^DIR K DIR
Q:$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)
I Y<1 G SELECT
;
;edit the batch TDN and amount
;it will prompt and display for user to confirm before filling new
;data on the collection batch
EDITBCH ;
W !,"Now Editing COLLECTION BATCH HEADER data:",!!
;
K DIR,DIE,DIC,X,Y,DA
S DIR(0)="F^6:20^K:'$$GOODIPAC^BARUFEX3(X) X"
S DIR("A")="Collection Batch TDN/IPAC"
S DIR("B")=$P($G(^BARCOL(DUZ(2),BARCBIEN,0)),U,28)
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) W !!,"NOTHING CHANGED",!! H 2 G SELECT
S BARNBCH=Y
K DIR,DIE,DIC,S,Y,DA
S DIR(0)="NOA^0:999999999:2"
S DIR("A")="Total Amount Batched: "
S DIR("B")=$P($G(^BARCOL(DUZ(2),BARCBIEN,0)),U,29)
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) W !!,"NOTHING CHANGED",!! H 2 G SELECT
S BARNAMT=Y
;IHS/SD/AML 5/3/2011 - Added ability to edit Deposit Date bar*1.8*20
K DIR,DIE,DIC,D,Y,DA
S DIR(0)="DO"
S DIR("A")="TDN/IPAC Deposit Date: "
S DIR("B")=$$SDT^BARDUTL($P($G(^BARCOL(DUZ(2),BARCBIEN,0)),U,30))
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) W !!,"NOTHING CHANGED",!! H 2 G SELECT
S BARNDDT=Y
;IHS/SD/AML 5/3/2011 - End ability to edit Deposit Date
;
;display header
W !!,"You have edited the COLLECTION BATCH HEADER data to reflect:",!!
W BARSTAR
W !?2,"Collection Batch: ",$P($G(^BARCOL(DUZ(2),BARCBIEN,0)),U),!
W BARSTAR
W !?4,"TDN/IPAC: ",BARNBCH
W ?40,"TOTAL AMOUNT BATCHED: $",$FN(BARNAMT,",",2)
W !?2,"Batched by: ",$P($G(^VA(200,$P($G(^BARCOL(DUZ(2),BARCBIEN,0)),U,5),0)),U)
W ?48,"DATE CREATED: ",$$SDT^BARDUTL($P($G(^BARCOL(DUZ(2),BARCBIEN,0)),U,4)),!
W "DEPOSIT DATE: ",$$SDT^BARDUTL(BARNDDT),!! ;IHS/SD/AML 5/3/2011 - ADD TDN/IPAC DEPOSIT DATE bar*1.*20
W BARDASH
;
S DIR(0)="Y"
S DIR("A")="Is this correct"
D ^DIR K DIR
I Y<1 G EDITBCH
;
;TDN entered is the same one on file now; don't edit
S BAROBCH=$P($G(^BARCOL(DUZ(2),BARCBIEN,0)),U,28)
I BAROBCH=BARNBCH D
.W !!,"TDN not changed. The TDN entered is the same one currently on file."
I BAROBCH'=BARNBCH D
.K DIC,DIE,DR,DA,X,Y
.S DA(1)=BARCBIEN
.S DIC="^BARCOL(DUZ(2),"_DA(1)_",1101,"
.S DIC(0)="LMQ"
.D NOW^%DTC
.S X=%
.S DIC("DR")=".02////28;.03////"_BAROBCH_";.04////"_BARNBCH_";.05////"_DUZ
.S DLAYGO=90050 ;Why not 90051.01? IHS/DIT/CPC - 20180309
.S DIC("P")=$P(^DD(90051.01,1101,0),U,2)
.D ^DIC
.K DIC,DIE,DR,DA,X,Y
.S DIE("NO^")="OUTOK"
.S DIE="^BARCOL(DUZ(2),"
.S DA=BARCBIEN
.S DR="28////"_BARNBCH
.D ^DIE
;
I $P($G(^BARCOL(DUZ(2),BARCBIEN,0)),U,29)=BARNAMT D
.W !!,"Amount not changed. The amount entered is the same one currently on file."
I $P($G(^BARCOL(DUZ(2),BARCBIEN,0)),U,29)'=BARNAMT D
.K DIC,DIE,DR,DA,X,Y
.S DA(1)=BARCBIEN
.S DIC="^BARCOL(DUZ(2),"_DA(1)_",1101,"
.S DIC(0)="LMQ"
.H 1
.D NOW^%DTC
.S X=%
.S DIC("DR")=".02////29;.03////"_$P($G(^BARCOL(DUZ(2),BARCBIEN,0)),U,29)_";.04////"_BARNAMT_";.05////"_DUZ
.S DLAYGO=90050
.S DIC("P")=$P(^DD(90051.01,1101,0),U,2)
.D ^DIC
.K DIC,DIE,DR,DA,X,Y
.S DIE("NO^")="OUTOK"
.S DIE="^BARCOL(DUZ(2),"
.S DA=BARCBIEN
.S DR="29////"_BARNAMT
.D ^DIE
;
;IHS/SD/AML 5/3/2011 - BEGIN NEW CODE - ADD ABILITY TO EDIT DEPOSIT DATE bar*1.8*20
I $P($G(^BARCOL(DUZ(2),BARCBIEN,0)),U,30)=BARNDDT D
.W !!,"Date not changed. The deposit date entered is the same one currently on file."
I $P($G(^BARCOL(DUZ(2),BARCBIEN,0)),U,30)'=BARNDDT D
.K DIC,DIE,DR,DA,D,X,Y
.S DA(1)=BARCBIEN
.S DIC="^BARCOL(DUZ(2),"_DA(1)_",1101,"
.S DIC(0)="LMQ"
.H 1
.D NOW^%DTC
.S X=%
.S DIC("DR")=".02////30;.03////"_$P($G(^BARCOL(DUZ(2),BARCBIEN,0)),U,30)_";.04////"_BARNDDT_";.05////"_DUZ
.S DLAYGO=90050
.S DIC("P")=$P(^DD(90051.01,1101,0),U,2)
.D ^DIC
.K DIC,DIE,DR,DA,D,X,Y
.S DIE("NO^")="OUTOK"
.S DIE="^BARCOL(DUZ(2),"
.S DA=BARCBIEN
.S DR="30////"_BARNDDT
.D ^DIE
.;
.;IHS/SD/AML 5/3/2011 - END NEW CODE
;now put this TDN on all items with the same TDN
S BARITEM=0
F S BARITEM=$O(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM)) Q:+BARITEM=0 D
.I $P($G(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,0)),U,20)=BAROBCH D
..K DIC,DIE,DR,DA,X,Y,D1
..S D0=BARCBIEN,D1=BARITEM ;;PARAMS FOR COLL BATCH ITEMS FIELD 20 OUTPUT TRANSFORM - IHS/DIT/CPC - BAR*1.8*28 CR5994
..S DA(1)=BARCBIEN
..S DA=BARITEM
..S DIE("NO^")="OUTOK"
..S DIE="^BARCOL(DUZ(2),"_DA(1)_",1,"
..S DR="20////"_BARNBCH
..D ^DIE
;
;now prompt to change items
EDITITEM ;
W !!,"Now editing Collection Batch Items....",!
W BARDASH,!
;W "Item",?9,"Check#",?27,"A/R ACCOUNT",?46,"TDN/IPAC",?69,"Amount" ;bar*1.8*28 IHS/SD/AML HEAT305486 CR5994
I $P($G(^BARCOL(DUZ(2),BARCBIEN,1,+BARITEM,0)),U,2)=51 W "Item",?9,"Check#",?27,"A/R ACCOUNT",?46,"TDN/IPAC",?69,"Amount" ;bar*1.8*28 IHS/SD/AML HEAT305486 CR5994 IHS/DIT/CPC 20180418
I $P($G(^BARCOL(DUZ(2),BARCBIEN,1,+BARITEM,0)),U,2)'=51 W "Item",?9,"Check#",?27,"A/R ACCOUNT",?46,"TDN/IPAC",?58,"TYPE",?69,"Amount" ;bar*1.8*28 IHS/SD/AML HEAT305486 CR5994 IHS/DIT/CPC 20180418
W !
W BARDASH
S BARITEM=0,BARCNT=0
F S BARITEM=$O(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM)) Q:+BARITEM=0 D
.S BARCNT=+$G(BARCNT)+1
.S BARPMTYP=$P($G(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,0)),U,2) ;bar*1.8*27 IHS/SD/AML HEAT305486 CR5994
.I $P($G(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,0)),U,17)'="",($P($G(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,0)),U,17)'="E") Q
.W !,$J(BARITEM,3) ;item number
.W ?5,$E($P($G(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,0)),U,11),1,20) ;item check#
.W ?27,$E($$GET1^DIQ(90051.1101,BARITEM_","_BARCBIEN_",",7,"E"),1,17) ;item A/R Acct
.W ?46,$P($G(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,0)),U,20) ;item TDN
.I BARPMTYP'=51 W ?58,$P(^BARTBL(BARPMTYP,0),U,6) ;bar*1.8*27 IHS/SD/AML HEAT305486 CR5994
.;W ?68,$J($FN($P($G(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,1)),U),",",2),12) ;item amt ;bar*1.8*27 IHS/SD/AML HEAT305486 CR5994
.W ?68,$J($FN($P($G(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,1)),U),",",2),12) ;item amt ;bar*1.8*27 IHS/SD/AML HEAT305486 CR5994
W !,BARDASH
K DIR,DIE,DIC,X,Y,DA
;S DIR(0)="NO^1:"_BARCNT
S DIR(0)="NO"
S DIR("A")="Select Collection Batch Item to edit"
D ^DIR K DIR
;
;I +Y'=0,(($P($G(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,0)),U,17)'="")&($P($G(^BARCOL(DUZ(2),BARCBIEN,1,+Y,0)),U,17)'="E")) W !!,"ITEM NOT EDITABLE; PLEASE CHOOSE FROM DISPLAYED ITEMS" H 1 W !! G EDITITEM ;MRS:BAR*1.8*10 H1359
I +Y'=0,(($P($G(^BARCOL(DUZ(2),BARCBIEN,1,+Y,0)),U,17)'="")&($P($G(^BARCOL(DUZ(2),BARCBIEN,1,+Y,0)),U,17)'="E")) W !!,"ITEM NOT EDITABLE; PLEASE CHOOSE FROM DISPLAYED ITEMS" H 1 W !! G EDITITEM ;MRS:BAR*1.8*10 H1359
;display selection
I +Y'=0 D
.S BARITEM=Y
.S BARPMTYP=$P($G(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,0)),U,2) ;bar*1.8*28 IHS/SD/AML HEAT305486 CR 5994
.W !!,$J(BARITEM,3) ;item number
.I '$G(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,0)) D ;IHS/DIT/CPC - 20180418 V1.8 P28
..S BAREND=1
..W !!,"There are no items associated with this batch.",!
..W "Please use the Collections Entry option to add the ",!
..W "missing batch item(s) before proceeding.",!!
..S DIR(0)="E",DIR("A")="Enter RETURN to Continue"
..D ^DIR
..Q ;IHS/DIT/CPC - 20180418 V1.8 P28
.Q:$G(BAREND)
.W ?5,$E($P($G(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,0)),U,11),1,20) ;item check#
.W ?27,$E($$GET1^DIQ(90051.1101,BARITEM_","_BARCBIEN_",",7,"E"),1,17) ;item A/R Acct
.W ?46,$P($G(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,0)),U,20) ;item TDN
.I BARPMTYP'=51 W ?58,$P(^BARTBL(BARPMTYP,0),U,6) ;bar*1.8*27 IHS/SD/AML HEAT305486 CR 5994
.W ?68,$J($FN($P($G(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,1)),U),",",2),12) ;item amt
.W !
.;bar*1.8*28 IHS/DIT/CPC HEAT 305486 CR 5994 SET UP ITEM AUDIT TEST VALUES
.S BARITMCK=$P($G(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,0)),U,11) ;item check#
.S BARITMACCT=$E($$GET1^DIQ(90051.1101,BARITEM_","_BARCBIEN_",",7,"I"),1,20) ;item A/R Acct
.S BARITMTDN=$P($G(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,0)),U,20) ;item TDN
.S BARITMAMT=$P($G(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,1)),U) ;item amt
.;
.;IHS/SD/AML 10/24/2013 - Edit Check Number - IHS/DIT/CPC - 20180309 Start New Code BAR*1.8*28 CR5994
.K DIC,DIE,X,Y,DA,DR
.S DA(1)=BARCBIEN
.S DA=BARITEM
.S DIE("NO^")="OUTOK"
.S DIE="^BARCOL(DUZ(2),"_DA(1)_",1,"
.S DR="11Check Number"
.D ^DIE
.I $D(Y) K DIC,DIE,X,Y,DA,DR Q
.D ITMAUDIT(BARCBIEN,BARITEM,"11",BARITMCK,$P($G(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,0)),U,11),DUZ)
.;Edit A/R Account
.K DIC,DIE,X,Y,DA,DR
.S DA(1)=BARCBIEN
.S DA=BARITEM
.S DIE("NO^")="OUTOK"
.S DIE="^BARCOL(DUZ(2),"_DA(1)_",1,"
.S DR="7A/R Account"
.D ^DIE
.I $D(Y) K DIC,DIE,X,Y,DA,DR Q
.D ITMAUDIT(BARCBIEN,BARITEM,"7",BARITMACCT,$E($$GET1^DIQ(90051.1101,BARITEM_","_BARCBIEN_",",7,"I"),1,20),DUZ)
.K DIC,DIE,X,Y,DA,DR
.S DA(1)=BARCBIEN
.S DA=BARITEM
.S DIE("NO^")="OUTOK"
.S DIE="^BARCOL(DUZ(2),"_DA(1)_",1,"
.S DR="101Item Amount"
.I $P($G(^BARCOL(DUZ(2),BARCBIEN,0)),U,28)="" S DR="20Item TDN;"_DR
.D ^DIE
.I $D(Y) K DIC,DIE,X,Y,DA,DR Q
.D ITMAUDIT(BARCBIEN,BARITEM,"101",BARITMAMT,$P($G(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,1)),U),DUZ)
.;end new bar*1.8*28 IHS/SD/AML HEAT305486 CR5994
EDITEOB .;
.I $P($G(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,6,0)),U,4)>1 D ;more than one EOB
..;list EOBs
..S BAREOB=0,BARCNT=0
..W !!,"Edit EOB Locations..."
..W !!?2,"#",?5,"VISIT LOCATION",?40,"AMOUNT",!,BARDASH
..F S BAREOB=$O(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,6,BAREOB)) Q:+BAREOB=0 D
...S BARCNT=+$G(BARCNT)+1
...W !,$J(BARCNT,3),?5,$P($G(^AUTTLOC($P($G(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,6,BAREOB,0)),U),0)),U,2)
...W ?40,$J($P($G(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,6,BAREOB,0)),U,2),",",2)
...S BARLIST(BARCNT)=BAREOB
..W !,BARDASH
..K DIR,DIE,DIC,X,Y,DA
..S DIR(0)="NO^1:"_BARCNT
..S DIR("A")="Select Item EOB to edit"
..D ^DIR K DIR
..S BARSEL=+Y
..Q:BARSEL<1
..K DIC,DIE,DA,X,Y,DR
..S DA(2)=BARCBIEN
..S DA(1)=BARITEM
..S DIE("NO^")="OUTOK"
..S DIE="^BARCOL(DUZ(2),"_DA(2)_",1,"_DA(1)_",6,"
..S DA=$G(BARLIST(BARSEL))
..S DR="2//"
..D ^DIE
.I +$G(BARSEL)>0 G EDITEOB
.;
.I $P($G(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,6,0)),U,4)=1 D ;one EOB
..K DIC,DIE,DA,X,Y,DR
..S DA(2)=BARCBIEN
..S DA(1)=BARITEM
..S DIE("NO^")="OUTOK"
..S DIE="^BARCOL(DUZ(2),"_DA(2)_",1,"_DA(1)_",6,"
..S DA=$O(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,6,0))
..S DR="2////"_$P($G(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,1)),U)
..D ^DIE
.;
.S BAREOB=0,BAREOBT=0
.F S BAREOB=$O(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,6,BAREOB)) Q:+BAREOB=0 D
..S BAREOBT=+$G(BAREOBT)+($P($G(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,6,BAREOB,0)),U,2))
.I BAREOBT'=+$P($G(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,1)),U) W !!,"Total of EOBs don't match item amount." G EDITEOB
;
S BARITTOT=$$ITEMTOT^BARCLU(BARCBIEN)
;
PICKEDIT ;
I $G(BAREND) D CLEANUP Q
I BARITTOT'=$P($G(^BARCOL(DUZ(2),BARCBIEN,0)),U,29) D
.W !!,"Batched amount of $",$FN(BARITTOT,",",2)," does not match TDN/IPAC amount of $",$FN($P($G(^BARCOL(DUZ(2),BARCBIEN,0)),U,29),",",2)
.K DIR,DIE,DIC,X,Y,DA
.S DIR(0)="SO^B:BATCH;I:ITEM"
.S DIR("A")="Which would you like to correct"
.D ^DIR K DIR
.S BARSEL=Y
I $G(BARSEL)="",(BARITTOT'=$P($G(^BARCOL(DUZ(2),BARCBIEN,0)),U,29)) G PICKEDIT
I "IB"'[($G(BARSEL)),(BARITTOT'=$P($G(^BARCOL(DUZ(2),BARCBIEN,0)),U,29)) G PICKEDIT
G:(BARITTOT'=$P($G(^BARCOL(DUZ(2),BARCBIEN,0)),U,29)&($G(BARSEL)="I")) EDITITEM
G:(BARITTOT'=$P($G(^BARCOL(DUZ(2),BARCBIEN,0)),U,29)&($G(BARSEL)="B")) EDITBCH
;
;if it gets here the batch and items balance and they haven't selected an item to edit
;I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) W !!,"NOTHING CHANGED",!!
;
S DIR(0)="E",DIR("A")="Enter RETURN to Continue" D EN
D ^DIR K DIR
D CLEANUP
Q
ITMAUDIT(BATCHIEN,ITEMIEN,FIELD,OLD,NEW,USER) ;BAR*1.8*28 ITEM AUDIT - IHS/DIT/CPC CR 5994
I OLD'=NEW D
.K DIC,DIE,DR,DA,D,X,Y
.S DA(1)=ITEMIEN
.S DA(2)=BATCHIEN
.S DIC="^BARCOL(DUZ(2),"_DA(2)_",1,"_DA(1)_",1101,"
.S DIC(0)="LMQ"
.H 1
.D NOW^%DTC
.S X=%
.S DIC("DR")=".02////"_FIELD_";.03////"_OLD_";.04////"_NEW_";.05////"_DUZ
.S DLAYGO=90051.1101
.D ^DIC
Q
CLEANUP ;BAR*1.8*28 - IHS/DIT/CPC CR 5994
K BARCNT,BARDASH,BAREND,BAREOB,BAREOBT,BAREQUAL,BARITDA,BARITEM,BARITMACCT,BARITMAMT
K BARITMCK,BARITMTDN,BARITTOT,BAROBCH,BARPMTYP,BARSTAR,BARVDDF
K C,D,D0,D1,DI,DIC,DR,X,Y
Q
;EOR - IHS/DIT/CPC 1.8*28
BAREBCH ; IHS/SD/SDR - EDIT COLLECTION BATCH/ITEMS JAN 15,1997 ; 11/21/2008
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**4,10,20,28**;OCT 26, 2005;Build 92
+2 ; New routine in bar*1.8*4 for DD item 4.1.5.2
+3 ;
+4 ;BAR*1.8*28 IHS/DIT/CPC - Added Edit Check Number CR5994
+5 ;BAR*1.8*28 IHS/DIT/CPC - Added Edit A/R Account CR5994
+6 ;BAR*1.8*28 IHS/DIT/CPC - Added Item Change Audit CR5994
+7 ;
EN ;EP;
+1 KILL BARSTAR,BAREQUAL,BARDASH
+2 KILL BARCBIEN,BARTRIEN,BARPFLG,BARVALUE
+3 ;K BARNBCH,BARNAMT ;IHS/SD/AML 5/3/2011 bar*1.8*20
+4 ;IHS/SD/AML 5/3/2011 bar*1.8*20
KILL BARNBCH,BARNAMT,BARNDDT
+5 ;
+6 SET $PIECE(BARSTAR,"*",79)="*"
+7 SET $PIECE(BAREQUAL,"=",79)="="
+8 SET $PIECE(BARDASH,"-",79)="-"
+9 ;
+10 WRITE !!,$$EN^BARVDF("RVN"),"Note: ",$$EN^BARVDF("RVF")
+11 ;IHS/DIT/CPC -20180425 Remove apostrophe BAR*1.8*28
WRITE "Collection Batch and Items that have not been posted may be modified."
+12 WRITE !?6,"If you entered a TDN/IPAC in error and the batch has been posted, you"
+13 WRITE !?6,"may not edit the TDN/IPAC and must notify your Finance Office to make"
+14 WRITE !?6,"adjustments in the financial system.",!!
+15 ;
SELECT ;
+1 IF $GET(BARCBIEN)'=""
Begin DoDot:1
+2 KILL BARCBIEN
+3 DO CLEAR^VALM1
End DoDot:1
+4 KILL DIC,DIE,X,Y,DA
+5 SET DIC="^BARCOL(DUZ(2),"
+6 SET DIC(0)="AEMQ"
+7 DO ^DIC
+8 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+9 IF Y<0
QUIT
+10 SET BARCBIEN=+Y
+11 ;
+12 ;check for payments posted to selected collection batch
+13 SET BARTRIEN=0
+14 SET BARPFLG=0
+15 FOR
SET BARTRIEN=$ORDER(^BARTR(DUZ(2),"AD",BARCBIEN,BARTRIEN))
IF +BARTRIEN=0!(BARPFLG=1)
QUIT
Begin DoDot:1
+16 IF $PIECE($GET(^BARTR(DUZ(2),BARTRIEN,1)),U)=40
SET BARPFLG=1
End DoDot:1
IF BARPFLG=1
QUIT
+17 ;
+18 IF BARPFLG=1
WRITE !!,"ITEMS WITHIN THIS COLLECTION BATCH ALREADY HAVE PAYMENTS POSTED AND IS THEREFORE UNEDITABLE",!!
HANG 2
KILL BARVALUE
GOTO SELECT
+19 ;no payments posted so display batch/item info and confirm entry
+20 ;;IHS/DIT/CPC - 20180418 V1.8 P28 CHECK FOR NO ITEMS IN BATCH
SET BARCNT=0
SET BAREND=0
SET BARITEM=0
+21 FOR
SET BARITEM=$ORDER(^BARCOL(DUZ(2),BARCBIEN,1,+BARITEM))
IF +BARITEM=0
QUIT
Begin DoDot:1
+22 SET BARCNT=+$GET(BARCNT)+1
End DoDot:1
+23 IF BARCNT=0
Begin DoDot:1
+24 SET BAREND=1
+25 WRITE !!,"There are no items associated with this batch.",!!
+26 WRITE "Please use the Collections Entry option to add the",!
+27 WRITE "missing batch item(s) before proceeding.",!!!
+28 SET DIR(0)="E"
SET DIR("A")="Enter RETURN to Continue"
+29 DO ^DIR
+30 QUIT
End DoDot:1
+31 ;IHS/DIT/CPC - 20180418 V1.8 P28 END NO ITEM CHECK
IF $GET(BAREND)
DO CLEANUP
QUIT
+32 WRITE !!!!
+33 WRITE BARSTAR
+34 WRITE !?2,"Collection Batch: ",$PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,0)),U),!
+35 WRITE BARSTAR
+36 WRITE !?4,"TDN/IPAC: ",$PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,0)),U,28)
+37 WRITE ?40,"TOTAL AMOUNT BATCHED: $",$FNUMBER($PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,0)),U,29),",",2)
+38 WRITE !?2,"Batched by: ",$PIECE($GET(^VA(200,$PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,0)),U,5),0)),U)
+39 WRITE ?48,"DATE CREATED: ",$$SDT^BARDUTL($PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,0)),U,4))
+40 ;IHS/SD/AML 5/3/2011 - ADD TDN/IPAC DEPOSIT DATE bar*1.8*20
WRITE !,"DEPOSIT DATE: ",$$SDT^BARDUTL($PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,0)),U,30)),!!
+41 WRITE "Item",?9,"Check#",?27,"A/R ACCOUNT",?46,"TDN/IPAC",?69,"Amount"
+42 WRITE !
+43 WRITE BARDASH
+44 SET BARITEM=0
+45 FOR
SET BARITEM=$ORDER(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM))
IF +BARITEM=0
QUIT
Begin DoDot:1
+46 IF $PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,0)),U,17)'=""
IF ($PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,0)),U,17)'="E")
QUIT
+47 ;item number
WRITE !,$JUSTIFY(BARITEM,3)
+48 ;item check#
WRITE ?5,$EXTRACT($PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,0)),U,11),1,20)
+49 ;item A/R Acct
WRITE ?27,$EXTRACT($$GET1^DIQ(90051.1101,BARITEM_","_BARCBIEN_",",7,"E"),1,17)
+50 ;item TDN
WRITE ?46,$PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,0)),U,20)
+51 ;item amt
WRITE ?68,$JUSTIFY($FNUMBER($PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,1)),U),",",2),12)
End DoDot:1
+52 ;
+53 SET DIR(0)="Y"
+54 SET DIR("A")="Correct"
+55 SET DIR("B")="Y"
+56 DO ^DIR
KILL DIR
+57 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
QUIT
+58 IF Y<1
GOTO SELECT
+59 ;
+60 ;edit the batch TDN and amount
+61 ;it will prompt and display for user to confirm before filling new
+62 ;data on the collection batch
EDITBCH ;
+1 WRITE !,"Now Editing COLLECTION BATCH HEADER data:",!!
+2 ;
+3 KILL DIR,DIE,DIC,X,Y,DA
+4 SET DIR(0)="F^6:20^K:'$$GOODIPAC^BARUFEX3(X) X"
+5 SET DIR("A")="Collection Batch TDN/IPAC"
+6 SET DIR("B")=$PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,0)),U,28)
+7 DO ^DIR
KILL DIR
+8 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
WRITE !!,"NOTHING CHANGED",!!
HANG 2
GOTO SELECT
+9 SET BARNBCH=Y
+10 KILL DIR,DIE,DIC,S,Y,DA
+11 SET DIR(0)="NOA^0:999999999:2"
+12 SET DIR("A")="Total Amount Batched: "
+13 SET DIR("B")=$PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,0)),U,29)
+14 DO ^DIR
KILL DIR
+15 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
WRITE !!,"NOTHING CHANGED",!!
HANG 2
GOTO SELECT
+16 SET BARNAMT=Y
+17 ;IHS/SD/AML 5/3/2011 - Added ability to edit Deposit Date bar*1.8*20
+18 KILL DIR,DIE,DIC,D,Y,DA
+19 SET DIR(0)="DO"
+20 SET DIR("A")="TDN/IPAC Deposit Date: "
+21 SET DIR("B")=$$SDT^BARDUTL($PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,0)),U,30))
+22 DO ^DIR
KILL DIR
+23 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
WRITE !!,"NOTHING CHANGED",!!
HANG 2
GOTO SELECT
+24 SET BARNDDT=Y
+25 ;IHS/SD/AML 5/3/2011 - End ability to edit Deposit Date
+26 ;
+27 ;display header
+28 WRITE !!,"You have edited the COLLECTION BATCH HEADER data to reflect:",!!
+29 WRITE BARSTAR
+30 WRITE !?2,"Collection Batch: ",$PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,0)),U),!
+31 WRITE BARSTAR
+32 WRITE !?4,"TDN/IPAC: ",BARNBCH
+33 WRITE ?40,"TOTAL AMOUNT BATCHED: $",$FNUMBER(BARNAMT,",",2)
+34 WRITE !?2,"Batched by: ",$PIECE($GET(^VA(200,$PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,0)),U,5),0)),U)
+35 WRITE ?48,"DATE CREATED: ",$$SDT^BARDUTL($PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,0)),U,4)),!
+36 ;IHS/SD/AML 5/3/2011 - ADD TDN/IPAC DEPOSIT DATE bar*1.*20
WRITE "DEPOSIT DATE: ",$$SDT^BARDUTL(BARNDDT),!!
+37 WRITE BARDASH
+38 ;
+39 SET DIR(0)="Y"
+40 SET DIR("A")="Is this correct"
+41 DO ^DIR
KILL DIR
+42 IF Y<1
GOTO EDITBCH
+43 ;
+44 ;TDN entered is the same one on file now; don't edit
+45 SET BAROBCH=$PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,0)),U,28)
+46 IF BAROBCH=BARNBCH
Begin DoDot:1
+47 WRITE !!,"TDN not changed. The TDN entered is the same one currently on file."
End DoDot:1
+48 IF BAROBCH'=BARNBCH
Begin DoDot:1
+49 KILL DIC,DIE,DR,DA,X,Y
+50 SET DA(1)=BARCBIEN
+51 SET DIC="^BARCOL(DUZ(2),"_DA(1)_",1101,"
+52 SET DIC(0)="LMQ"
+53 DO NOW^%DTC
+54 SET X=%
+55 SET DIC("DR")=".02////28;.03////"_BAROBCH_";.04////"_BARNBCH_";.05////"_DUZ
+56 ;Why not 90051.01? IHS/DIT/CPC - 20180309
SET DLAYGO=90050
+57 SET DIC("P")=$PIECE(^DD(90051.01,1101,0),U,2)
+58 DO ^DIC
+59 KILL DIC,DIE,DR,DA,X,Y
+60 SET DIE("NO^")="OUTOK"
+61 SET DIE="^BARCOL(DUZ(2),"
+62 SET DA=BARCBIEN
+63 SET DR="28////"_BARNBCH
+64 DO ^DIE
End DoDot:1
+65 ;
+66 IF $PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,0)),U,29)=BARNAMT
Begin DoDot:1
+67 WRITE !!,"Amount not changed. The amount entered is the same one currently on file."
End DoDot:1
+68 IF $PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,0)),U,29)'=BARNAMT
Begin DoDot:1
+69 KILL DIC,DIE,DR,DA,X,Y
+70 SET DA(1)=BARCBIEN
+71 SET DIC="^BARCOL(DUZ(2),"_DA(1)_",1101,"
+72 SET DIC(0)="LMQ"
+73 HANG 1
+74 DO NOW^%DTC
+75 SET X=%
+76 SET DIC("DR")=".02////29;.03////"_$PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,0)),U,29)_";.04////"_BARNAMT_";.05////"_DUZ
+77 SET DLAYGO=90050
+78 SET DIC("P")=$PIECE(^DD(90051.01,1101,0),U,2)
+79 DO ^DIC
+80 KILL DIC,DIE,DR,DA,X,Y
+81 SET DIE("NO^")="OUTOK"
+82 SET DIE="^BARCOL(DUZ(2),"
+83 SET DA=BARCBIEN
+84 SET DR="29////"_BARNAMT
+85 DO ^DIE
End DoDot:1
+86 ;
+87 ;IHS/SD/AML 5/3/2011 - BEGIN NEW CODE - ADD ABILITY TO EDIT DEPOSIT DATE bar*1.8*20
+88 IF $PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,0)),U,30)=BARNDDT
Begin DoDot:1
+89 WRITE !!,"Date not changed. The deposit date entered is the same one currently on file."
End DoDot:1
+90 IF $PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,0)),U,30)'=BARNDDT
Begin DoDot:1
+91 KILL DIC,DIE,DR,DA,D,X,Y
+92 SET DA(1)=BARCBIEN
+93 SET DIC="^BARCOL(DUZ(2),"_DA(1)_",1101,"
+94 SET DIC(0)="LMQ"
+95 HANG 1
+96 DO NOW^%DTC
+97 SET X=%
+98 SET DIC("DR")=".02////30;.03////"_$PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,0)),U,30)_";.04////"_BARNDDT_";.05////"_DUZ
+99 SET DLAYGO=90050
+100 SET DIC("P")=$PIECE(^DD(90051.01,1101,0),U,2)
+101 DO ^DIC
+102 KILL DIC,DIE,DR,DA,D,X,Y
+103 SET DIE("NO^")="OUTOK"
+104 SET DIE="^BARCOL(DUZ(2),"
+105 SET DA=BARCBIEN
+106 SET DR="30////"_BARNDDT
+107 DO ^DIE
+108 ;
+109 ;IHS/SD/AML 5/3/2011 - END NEW CODE
End DoDot:1
+110 ;now put this TDN on all items with the same TDN
+111 SET BARITEM=0
+112 FOR
SET BARITEM=$ORDER(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM))
IF +BARITEM=0
QUIT
Begin DoDot:1
+113 IF $PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,0)),U,20)=BAROBCH
Begin DoDot:2
+114 KILL DIC,DIE,DR,DA,X,Y,D1
+115 ;;PARAMS FOR COLL BATCH ITEMS FIELD 20 OUTPUT TRANSFORM - IHS/DIT/CPC - BAR*1.8*28 CR5994
SET D0=BARCBIEN
SET D1=BARITEM
+116 SET DA(1)=BARCBIEN
+117 SET DA=BARITEM
+118 SET DIE("NO^")="OUTOK"
+119 SET DIE="^BARCOL(DUZ(2),"_DA(1)_",1,"
+120 SET DR="20////"_BARNBCH
+121 DO ^DIE
End DoDot:2
End DoDot:1
+122 ;
+123 ;now prompt to change items
EDITITEM ;
+1 WRITE !!,"Now editing Collection Batch Items....",!
+2 WRITE BARDASH,!
+3 ;W "Item",?9,"Check#",?27,"A/R ACCOUNT",?46,"TDN/IPAC",?69,"Amount" ;bar*1.8*28 IHS/SD/AML HEAT305486 CR5994
+4 ;bar*1.8*28 IHS/SD/AML HEAT305486 CR5994 IHS/DIT/CPC 20180418
IF $PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,1,+BARITEM,0)),U,2)=51
WRITE "Item",?9,"Check#",?27,"A/R ACCOUNT",?46,"TDN/IPAC",?69,"Amount"
+5 ;bar*1.8*28 IHS/SD/AML HEAT305486 CR5994 IHS/DIT/CPC 20180418
IF $PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,1,+BARITEM,0)),U,2)'=51
WRITE "Item",?9,"Check#",?27,"A/R ACCOUNT",?46,"TDN/IPAC",?58,"TYPE",?69,"Amount"
+6 WRITE !
+7 WRITE BARDASH
+8 SET BARITEM=0
SET BARCNT=0
+9 FOR
SET BARITEM=$ORDER(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM))
IF +BARITEM=0
QUIT
Begin DoDot:1
+10 SET BARCNT=+$GET(BARCNT)+1
+11 ;bar*1.8*27 IHS/SD/AML HEAT305486 CR5994
SET BARPMTYP=$PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,0)),U,2)
+12 IF $PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,0)),U,17)'=""
IF ($PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,0)),U,17)'="E")
QUIT
+13 ;item number
WRITE !,$JUSTIFY(BARITEM,3)
+14 ;item check#
WRITE ?5,$EXTRACT($PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,0)),U,11),1,20)
+15 ;item A/R Acct
WRITE ?27,$EXTRACT($$GET1^DIQ(90051.1101,BARITEM_","_BARCBIEN_",",7,"E"),1,17)
+16 ;item TDN
WRITE ?46,$PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,0)),U,20)
+17 ;bar*1.8*27 IHS/SD/AML HEAT305486 CR5994
IF BARPMTYP'=51
WRITE ?58,$PIECE(^BARTBL(BARPMTYP,0),U,6)
+18 ;W ?68,$J($FN($P($G(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,1)),U),",",2),12) ;item amt ;bar*1.8*27 IHS/SD/AML HEAT305486 CR5994
+19 ;item amt ;bar*1.8*27 IHS/SD/AML HEAT305486 CR5994
WRITE ?68,$JUSTIFY($FNUMBER($PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,1)),U),",",2),12)
End DoDot:1
+20 WRITE !,BARDASH
+21 KILL DIR,DIE,DIC,X,Y,DA
+22 ;S DIR(0)="NO^1:"_BARCNT
+23 SET DIR(0)="NO"
+24 SET DIR("A")="Select Collection Batch Item to edit"
+25 DO ^DIR
KILL DIR
+26 ;
+27 ;I +Y'=0,(($P($G(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,0)),U,17)'="")&($P($G(^BARCOL(DUZ(2),BARCBIEN,1,+Y,0)),U,17)'="E")) W !!,"ITEM NOT EDITABLE; PLEASE CHOOSE FROM DISPLAYED ITEMS" H 1 W !! G EDITITEM ;MRS:BAR*1.8*10 H1359
+28 ;MRS:BAR*1.8*10 H1359
IF +Y'=0
IF (($PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,1,+Y,0)),U,17)'="")&($PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,1,+Y,0)),U,17)'="E"))
WRITE !!,"ITEM NOT EDITABLE; PLEASE CHOOSE FROM DISPLAYED ITEMS"
HANG 1
WRITE !!
GOTO EDITITEM
+29 ;display selection
+30 IF +Y'=0
Begin DoDot:1
+31 SET BARITEM=Y
+32 ;bar*1.8*28 IHS/SD/AML HEAT305486 CR 5994
SET BARPMTYP=$PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,0)),U,2)
+33 ;item number
WRITE !!,$JUSTIFY(BARITEM,3)
+34 ;IHS/DIT/CPC - 20180418 V1.8 P28
IF '$GET(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,0))
Begin DoDot:2
+35 SET BAREND=1
+36 WRITE !!,"There are no items associated with this batch.",!
+37 WRITE "Please use the Collections Entry option to add the ",!
+38 WRITE "missing batch item(s) before proceeding.",!!
+39 SET DIR(0)="E"
SET DIR("A")="Enter RETURN to Continue"
+40 DO ^DIR
+41 ;IHS/DIT/CPC - 20180418 V1.8 P28
QUIT
End DoDot:2
+42 IF $GET(BAREND)
QUIT
+43 ;item check#
WRITE ?5,$EXTRACT($PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,0)),U,11),1,20)
+44 ;item A/R Acct
WRITE ?27,$EXTRACT($$GET1^DIQ(90051.1101,BARITEM_","_BARCBIEN_",",7,"E"),1,17)
+45 ;item TDN
WRITE ?46,$PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,0)),U,20)
+46 ;bar*1.8*27 IHS/SD/AML HEAT305486 CR 5994
IF BARPMTYP'=51
WRITE ?58,$PIECE(^BARTBL(BARPMTYP,0),U,6)
+47 ;item amt
WRITE ?68,$JUSTIFY($FNUMBER($PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,1)),U),",",2),12)
+48 WRITE !
+49 ;bar*1.8*28 IHS/DIT/CPC HEAT 305486 CR 5994 SET UP ITEM AUDIT TEST VALUES
+50 ;item check#
SET BARITMCK=$PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,0)),U,11)
+51 ;item A/R Acct
SET BARITMACCT=$EXTRACT($$GET1^DIQ(90051.1101,BARITEM_","_BARCBIEN_",",7,"I"),1,20)
+52 ;item TDN
SET BARITMTDN=$PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,0)),U,20)
+53 ;item amt
SET BARITMAMT=$PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,1)),U)
+54 ;
+55 ;IHS/SD/AML 10/24/2013 - Edit Check Number - IHS/DIT/CPC - 20180309 Start New Code BAR*1.8*28 CR5994
+56 KILL DIC,DIE,X,Y,DA,DR
+57 SET DA(1)=BARCBIEN
+58 SET DA=BARITEM
+59 SET DIE("NO^")="OUTOK"
+60 SET DIE="^BARCOL(DUZ(2),"_DA(1)_",1,"
+61 SET DR="11Check Number"
+62 DO ^DIE
+63 IF $DATA(Y)
KILL DIC,DIE,X,Y,DA,DR
QUIT
+64 DO ITMAUDIT(BARCBIEN,BARITEM,"11",BARITMCK,$PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,0)),U,11),DUZ)
+65 ;Edit A/R Account
+66 KILL DIC,DIE,X,Y,DA,DR
+67 SET DA(1)=BARCBIEN
+68 SET DA=BARITEM
+69 SET DIE("NO^")="OUTOK"
+70 SET DIE="^BARCOL(DUZ(2),"_DA(1)_",1,"
+71 SET DR="7A/R Account"
+72 DO ^DIE
+73 IF $DATA(Y)
KILL DIC,DIE,X,Y,DA,DR
QUIT
+74 DO ITMAUDIT(BARCBIEN,BARITEM,"7",BARITMACCT,$EXTRACT($$GET1^DIQ(90051.1101,BARITEM_","_BARCBIEN_",",7,"I"),1,20),DUZ)
+75 KILL DIC,DIE,X,Y,DA,DR
+76 SET DA(1)=BARCBIEN
+77 SET DA=BARITEM
+78 SET DIE("NO^")="OUTOK"
+79 SET DIE="^BARCOL(DUZ(2),"_DA(1)_",1,"
+80 SET DR="101Item Amount"
+81 IF $PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,0)),U,28)=""
SET DR="20Item TDN;"_DR
+82 DO ^DIE
+83 IF $DATA(Y)
KILL DIC,DIE,X,Y,DA,DR
QUIT
+84 DO ITMAUDIT(BARCBIEN,BARITEM,"101",BARITMAMT,$PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,1)),U),DUZ)
+85 ;end new bar*1.8*28 IHS/SD/AML HEAT305486 CR5994
EDITEOB ;
+1 ;more than one EOB
IF $PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,6,0)),U,4)>1
Begin DoDot:2
+2 ;list EOBs
+3 SET BAREOB=0
SET BARCNT=0
+4 WRITE !!,"Edit EOB Locations..."
+5 WRITE !!?2,"#",?5,"VISIT LOCATION",?40,"AMOUNT",!,BARDASH
+6 FOR
SET BAREOB=$ORDER(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,6,BAREOB))
IF +BAREOB=0
QUIT
Begin DoDot:3
+7 SET BARCNT=+$GET(BARCNT)+1
+8 WRITE !,$JUSTIFY(BARCNT,3),?5,$PIECE($GET(^AUTTLOC($PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,6,BAREOB,0)),U),0)),U,2)
+9 WRITE ?40,$JUSTIFY($PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,6,BAREOB,0)),U,2),",",2)
+10 SET BARLIST(BARCNT)=BAREOB
End DoDot:3
+11 WRITE !,BARDASH
+12 KILL DIR,DIE,DIC,X,Y,DA
+13 SET DIR(0)="NO^1:"_BARCNT
+14 SET DIR("A")="Select Item EOB to edit"
+15 DO ^DIR
KILL DIR
+16 SET BARSEL=+Y
+17 IF BARSEL<1
QUIT
+18 KILL DIC,DIE,DA,X,Y,DR
+19 SET DA(2)=BARCBIEN
+20 SET DA(1)=BARITEM
+21 SET DIE("NO^")="OUTOK"
+22 SET DIE="^BARCOL(DUZ(2),"_DA(2)_",1,"_DA(1)_",6,"
+23 SET DA=$GET(BARLIST(BARSEL))
+24 SET DR="2//"
+25 DO ^DIE
End DoDot:2
+26 IF +$GET(BARSEL)>0
GOTO EDITEOB
+27 ;
+28 ;one EOB
IF $PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,6,0)),U,4)=1
Begin DoDot:2
+29 KILL DIC,DIE,DA,X,Y,DR
+30 SET DA(2)=BARCBIEN
+31 SET DA(1)=BARITEM
+32 SET DIE("NO^")="OUTOK"
+33 SET DIE="^BARCOL(DUZ(2),"_DA(2)_",1,"_DA(1)_",6,"
+34 SET DA=$ORDER(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,6,0))
+35 SET DR="2////"_$PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,1)),U)
+36 DO ^DIE
End DoDot:2
+37 ;
+38 SET BAREOB=0
SET BAREOBT=0
+39 FOR
SET BAREOB=$ORDER(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,6,BAREOB))
IF +BAREOB=0
QUIT
Begin DoDot:2
+40 SET BAREOBT=+$GET(BAREOBT)+($PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,6,BAREOB,0)),U,2))
End DoDot:2
+41 IF BAREOBT'=+$PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,1,BARITEM,1)),U)
WRITE !!,"Total of EOBs don't match item amount."
GOTO EDITEOB
End DoDot:1
+42 ;
+43 SET BARITTOT=$$ITEMTOT^BARCLU(BARCBIEN)
+44 ;
PICKEDIT ;
+1 IF $GET(BAREND)
DO CLEANUP
QUIT
+2 IF BARITTOT'=$PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,0)),U,29)
Begin DoDot:1
+3 WRITE !!,"Batched amount of $",$FNUMBER(BARITTOT,",",2)," does not match TDN/IPAC amount of $",$FNUMBER($PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,0)),U,29),",",2)
+4 KILL DIR,DIE,DIC,X,Y,DA
+5 SET DIR(0)="SO^B:BATCH;I:ITEM"
+6 SET DIR("A")="Which would you like to correct"
+7 DO ^DIR
KILL DIR
+8 SET BARSEL=Y
End DoDot:1
+9 IF $GET(BARSEL)=""
IF (BARITTOT'=$PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,0)),U,29))
GOTO PICKEDIT
+10 IF "IB"'[($GET(BARSEL))
IF (BARITTOT'=$PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,0)),U,29))
GOTO PICKEDIT
+11 IF (BARITTOT'=$PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,0)),U,29)&($GET(BARSEL)="I"))
GOTO EDITITEM
+12 IF (BARITTOT'=$PIECE($GET(^BARCOL(DUZ(2),BARCBIEN,0)),U,29)&($GET(BARSEL)="B"))
GOTO EDITBCH
+13 ;
+14 ;if it gets here the batch and items balance and they haven't selected an item to edit
+15 ;I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) W !!,"NOTHING CHANGED",!!
+16 ;
+17 SET DIR(0)="E"
SET DIR("A")="Enter RETURN to Continue"
DO EN
+18 DO ^DIR
KILL DIR
+19 DO CLEANUP
+20 QUIT
ITMAUDIT(BATCHIEN,ITEMIEN,FIELD,OLD,NEW,USER) ;BAR*1.8*28 ITEM AUDIT - IHS/DIT/CPC CR 5994
+1 IF OLD'=NEW
Begin DoDot:1
+2 KILL DIC,DIE,DR,DA,D,X,Y
+3 SET DA(1)=ITEMIEN
+4 SET DA(2)=BATCHIEN
+5 SET DIC="^BARCOL(DUZ(2),"_DA(2)_",1,"_DA(1)_",1101,"
+6 SET DIC(0)="LMQ"
+7 HANG 1
+8 DO NOW^%DTC
+9 SET X=%
+10 SET DIC("DR")=".02////"_FIELD_";.03////"_OLD_";.04////"_NEW_";.05////"_DUZ
+11 SET DLAYGO=90051.1101
+12 DO ^DIC
End DoDot:1
+13 QUIT
CLEANUP ;BAR*1.8*28 - IHS/DIT/CPC CR 5994
+1 KILL BARCNT,BARDASH,BAREND,BAREOB,BAREOBT,BAREQUAL,BARITDA,BARITEM,BARITMACCT,BARITMAMT
+2 KILL BARITMCK,BARITMTDN,BARITTOT,BAROBCH,BARPMTYP,BARSTAR,BARVDDF
+3 KILL C,D,D0,D1,DI,DIC,DR,X,Y
+4 QUIT
+5 ;EOR - IHS/DIT/CPC 1.8*28
