| 1 | FBAARD0 ;AISC/GRR-VOUCHER AUDIT DELETE REJECTS ENTERED IN ERROR CONT. ;01JAN86
|
|---|
| 2 | ;;3.5;FEE BASIS;;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | HELPD W !!,"If you answer 'Yes' to this question, all payment items in this batch",!,"will be flagged as rejected! If you answer 'No', you will be asked if you"
|
|---|
| 5 | W !,"want to reject specific line items!"
|
|---|
| 6 | Q
|
|---|
| 7 | DELC S (QQ,FBAAOUT)=0 W @IOF D HEDC^FBAACCB1 F I=0:0 S I=$O(^FBAAI("AH",B,I)) Q:I'>0!(FBAAOUT) I $D(^FBAAI(I,0)) S Z(0)=^(0) D WRITC
|
|---|
| 8 | RL S ERR=0 S DIR(0)="N^1:"_QQ,DIR("A")="Delete reject flag for which line item" D ^DIR K DIR Q:$D(DIRUT) S HX=X
|
|---|
| 9 | I '$D(QQ(HX)) W !,*7,"You already did that one !!" G RL
|
|---|
| 10 | ASKSU S DIR(0)="Y",DIR("A")="Are you sure you want to delete the reject on item number "_HX,DIR("B")="NO" D ^DIR K DIR G:$D(DIRUT)!'Y RL
|
|---|
| 11 | S I=QQ(HX),(FBAAAP,FBAAMT)=+$P(^FBAAI(I,0),"^",9),FBII78=$P($G(^(0)),"^",5),FBMM=$E($P(^(0),U,6),4,5) S FBINVI=I D INPOST^FBAARD3 S I=FBINVI K FBINVI I $D(FBERR) G PROB^FBAARD1
|
|---|
| 12 | S $P(^FBAAI(I,0),"^",17)=$P(^FBAAI(I,"FBREJ"),"^",3),^FBAAI("AC",B,I)="",^FBAAI("AE",B,$P(^FBAAI(I,0),"^",4),I)="" K FBMM,^FBAAI("AH",B,I),^FBAAI(I,"FBREJ") S FBAARA=FBAARA+FBAAAP
|
|---|
| 13 | S $P(FZ,"^",9)=$P(FZ,"^",9)+FBAAAP,$P(FZ,"^",10)=$P(FZ,"^",10)+1,$P(FZ,"^",11)=$P(FZ,"^",11)+1 I '$D(^FBAAI("AH",B)) S $P(FZ,"^",17)="",^FBAA(161.7,B,0)=FZ W !,"...Done" Q
|
|---|
| 14 | S ^FBAA(161.7,B,0)=FZ W !,"...Done"
|
|---|
| 15 | RDMORE S DIR(0)="Y",DIR("A")=$S($G(FBERR):"",1:"Item Deleted. ")_"Want to delete another",DIR("B")="YES" D ^DIR K DIR G RDMORE:$D(DIRUT),RL:Y
|
|---|
| 16 | Q
|
|---|
| 17 | WRITC S QQ=QQ+1,QQ(QQ)=I D CMORE^FBAACCB1 Q
|
|---|
