source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBAARD3.m@ 1150

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

initial load of WorldVistAEHR

File size: 1.5 KB
Line 
1FBAARD3 ;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.
4STUFF 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 ;
11POST ;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 ;
19INPOST ;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
Note: See TracBrowser for help on using the repository browser.