1 | FBAARD3 ;AISC/GRR-VOUCHER AUDIT DELETE REJECTS ENTERED IN ERROR ;08JAN86
|
---|
2 | ;;3.5;FEE BASIS;;JAN 30, 1995
|
---|
3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | STUFF S (FBAAMT,FBAAAP)=+$P(^FBAAC(J,1,K,1,L,1,M,0),"^",3) D POST G PROB^FBAARD1:$D(FBERR)
|
---|
5 | S $P(^FBAAC(J,1,K,1,L,1,M,0),"^",8)=$P(^FBAAC(J,1,K,1,L,1,M,"FBREJ"),"^",3),FBAARA=FBAARA+FBAAAP,FBIN=$P(^FBAAC(J,1,K,1,L,1,M,0),"^",16)
|
---|
6 | S ^FBAAC("AC",B,J,K,L,M)="",^FBAAC("AJ",B,FBIN,J,K,L,M)="" K ^FBAAC("AH",B,J,K,L,M) S $P(FZ,"^",9)=($P(FZ,"^",9)+FBAAAP),$P(FZ,"^",11)=($P(FZ,"^",11)+1)
|
---|
7 | K ^FBAAC(J,1,K,1,L,1,M,"FBREJ")
|
---|
8 | I '$D(^FBAAC("AH",B)) S $P(FZ,"^",17)=""
|
---|
9 | Q
|
---|
10 | ;
|
---|
11 | POST ;entry point to put dollars back into an authorization on the 1358
|
---|
12 | ;if rejected in error
|
---|
13 | ;first will locate interface ID from PRC(424,"E",IEN of 161.7)
|
---|
14 | ;if interface not exist use old call to POST^FBAASCB
|
---|
15 | ;I '$$VER^FBAAUTL1() D POST^FBAASCB Q
|
---|
16 | I '$O(^PRC(424,"E",+$G(FBN),0)) D POST^FBAASCB Q
|
---|
17 | D ADD^FBAAUTL1 Q
|
---|
18 | ;
|
---|
19 | INPOST ;call to put money back into 1358 for inpatient invoices
|
---|
20 | ;call will handle both v4 and v3.6 of ifcap
|
---|
21 | ;I $G(FBCNH),'$$VER^FBAAUTL1() D POST^FBAASCB Q
|
---|
22 | I FBII78["FB583(" D POST Q
|
---|
23 | ;find 7078 entry and build variables needed for call
|
---|
24 | I '$D(^FB7078(+FBII78,0)) W !,"No 7078 on file for invoice ",J,". Could not determine 1358.",! S FBERR=1 Q
|
---|
25 | S FBI78=$P(^FB7078(+FBII78,0),"^"),DFN=+$P(^(0),"^",3),FBI78=$P(FZ,"^",8)_"-"_$P(FBI78,".")_"-"_$P(FBI78,".",2) D
|
---|
26 | .I $D(FBCNH),'$D(^PRC(424,"E",DFN_";"_+FBII78_";"_FBAAON_";"_FBMM)) D POST Q
|
---|
27 | .D INPOST^FBAASCB0:$$INTER^FBAASCB0()
|
---|
28 | Q
|
---|