source: FOIAVistA/trunk/r/FEE_BASIS-FB/FBAARD2.m@ 1274

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

initial load of FOIAVistA 6/30/08 version

File size: 3.4 KB
Line 
1FBAARD2 ;AISC/GRR-FEE BASIS VOUCHER AUDIT DELETE REJECT CODE FOR AN ITEM ;10AUG86
2 ;;3.5;FEE BASIS;;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4DELT ;TRAVEL LINE ITEM REJECT
5 K QQ
6 D GET^FBAAVR2 Q:X="^"!(X="") I '$D(^FBAAC("AG",B,J)) W !!,*7,"No payments rejected in this batch for that patient!" G DELT
7 S (QQ,TM1,TM2)=0 W @IOF D HEDP^FBAACCB0
8 F K=0:0 S K=$O(^FBAAC("AG",B,J,K)) Q:K'>0 S QQ=QQ+1,QQ(QQ)=J_"^"_K S Y(0)=^FBAAC(J,3,K,0) D SETT^FBAACCB0
9RLT1 S DIR(0)="Y",DIR("A")="Delete Reject flag for all items for this patient",DIR("B")="YES" D ^DIR K DIR Q:$D(DIRUT) G LOOPT:Y
10RLT S DIR(0)="N^1:"_QQ,DIR("A")="Delete reject for which line item" D ^DIR K DIR Q:$D(DIRUT) S HX=X
11 I '$D(QQ(HX)) W !!,*7,"You just deleted that one!!" G RLT
12ASKK S DIR(0)="Y",DIR("A")="Are you sure you want to delete reject for item number "_HX,DIR("B")="NO" D ^DIR K DIR G:$D(DIRUT)!'Y RLT
13 S J=$P(QQ(HX),"^",1),K=$P(QQ(HX),"^",2)
14 D STUFFT G RDMORT
15STUFFT D REJT^FBAARD1 S (FBAAMT,FBAAAP)=$P(^FBAAC(J,3,K,0),"^",3) D POST^FBAARD3 I $D(FBERR) G PROB^FBAARD1
16 S $P(FZ,"^",9)=($P(FZ,"^",9)+FBAAAP),$P(FZ,"^",11)=($P(FZ,"^",11)+1) K QQ(HX) S FBAARA=FBAARA+FBAAAP
17 S $P(^FBAA(161.7,B,0),"^",9)=$P(FZ,"^",9),$P(^(0),"^",11)=$P(FZ,"^",11)
18 Q
19RDMORT S DIR(0)="Y",DIR("A")=$S($G(FBERR):"",1:"Item Deleted. ")_"Want to delete another",DIR("B")="YES" D ^DIR K DIR G RDMORT:$D(DIRUT),RLT:Y
20 I '$D(^FBAAC("AG",B)) S $P(FZ,"^",17)="",$P(^FBAA(161.7,B,0),"^",17)=""
21 Q
22DELP ;PHARMACY LINE ITEM DELETE REJECT DESIGNATION
23RDI K QQ W !! S DIC="^FBAA(162.1,",DIC(0)="AEQ" D ^DIC Q:X="^"!(X="") G:Y<0 RDI S A=+Y I '$D(^FBAA(162.1,"AF",B,A)) W !!,*7,"No payments rejected in this batch for that Invoice!" G RDI
24 S (QQ,TM1,TM2)=0,FBIN=A W @IOF D SETV^FBAACCB0,HED^FBAACCB
25 F B2=0:0 S B2=$O(^FBAA(162.1,"AF",B,A,B2)) Q:B2'>0 S QQ=QQ+1,QQ(QQ)=A_"^"_B2 S Z(0)=^FBAA(162.1,A,"RX",B2,0) D MORE^FBAACCB1
26RLP1 S DIR(0)="Y",DIR("A")="Delete Reject code for all items for this patient",DIR("B")="YES" D ^DIR K DIR Q:$D(DIRUT) G LOOPP:Y
27RLP S DIR(0)="N^1:"_QQ,DIR("A")="Delete reject code for which line item" D ^DIR K DIR Q:$D(DIRUT) S HX=X
28 I '$D(QQ(HX)) W !!,*7,"You just deleted that one!!" G RLP
29ASKJJ S DIR(0)="Y",DIR("A")="Are you sure you want to delete reject for item number "_HX,DIR("B")="NO" D ^DIR K DIR G:$D(DIRUT)!'Y RLP
30 S A=$P(QQ(HX),"^",1),B2=$P(QQ(HX),"^",2)
31 D STUFFP G RDMORP
32STUFFP S (FBAAAP,FBAAMT)=$P(^FBAA(162.1,A,"RX",B2,0),"^",16) D POST^FBAARD3 I $D(FBERR) G PROB^FBAARD1
33 S $P(^FBAA(162.1,A,"RX",B2,0),"^",17)=B,FBPID=$P(^(0),"^",5)
34 S FBAARA=FBAARA+FBAAAP,$P(FZ,"^",9)=($P(FZ,"^",9)+$P(^FBAA(162.1,A,"RX",B2,0),"^",16)),$P(FZ,"^",11)=($P(FZ,"^",11)+1),^FBAA(162.1,"AE",B,A,B2)="",^FBAA(162.1,"AJ",B,FBPID,A,B2)="" K ^FBAA(162.1,"AF",B,A,B2),^FBAA(162.1,A,"RX",B2,"FBREJ")
35 S $P(^FBAA(161.7,B,0),"^",9)=$P(FZ,"^",9),$P(^(0),"^",11)=$P(FZ,"^",11)
36 Q
37RDMORP S DIR(0)="Y",DIR("A")=$S($G(FBERR):"",1:"Reject code deleted! ")_"Want to delete another",DIR("B")="YES" D ^DIR K DIR G RDMORP:$D(DIRUT),RLP:Y
38 I '$D(^FBAA(162.1,"AF",B)) S $P(FZ,"^",17)="",$P(^FBAA(161.7,B,0),"^",17)=""
39 Q
40LOOPT F HX=0:0 S HX=$O(QQ(HX)) Q:HX'>0 S J=$P(QQ(HX),"^",1),K=$P(QQ(HX),"^",2) D STUFFT
41 W !,"...DONE!"
42 I '$D(^FBAAC("AG",B)) S $P(FZ,"^",17)="",$P(FBAA(161.7,B,0),"^",17)=""
43 G DELT
44LOOPP F HX=0:0 S HX=$O(QQ(HX)) Q:HX'>0 S A=$P(QQ(HX),"^",1),B2=$P(QQ(HX),"^",2) D STUFFP
45 I '$D(^FBAA(162.1,"AF",B)) S $P(FZ,"^",17)="",$P(^FBAA(161.7,B,0),"^",17)=""
46 W !,"...DONE!" G DELP
Note: See TracBrowser for help on using the repository browser.