source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBAARD0.m@ 1556

Last change on this file since 1556 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.5 KB
Line 
1FBAARD0 ;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.
4HELPD 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
7DELC 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
8RL 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
10ASKSU 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"
15RDMORE 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
17WRITC S QQ=QQ+1,QQ(QQ)=I D CMORE^FBAACCB1 Q
Note: See TracBrowser for help on using the repository browser.