FBAARD3 ;AISC/GRR-VOUCHER AUDIT DELETE REJECTS ENTERED IN ERROR ;3/27/2012
;;3.5;FEE BASIS;**132**;JAN 30, 1995;Build 17
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
POST ;entry point to put dollars back into an authorization on the 1358
;if rejected in error
;first will locate interface ID from PRC(424,"E",IEN of 161.7)
;if interface not exist use old call to POST^FBAASCB
;I '$$VER^FBAAUTL1() D POST^FBAASCB Q
I '$O(^PRC(424,"E",+$G(FBN),0)) D POST^FBAASCB Q
D ADD^FBAAUTL1 Q
;
INPOST ;call to put money back into 1358 for inpatient invoices
;call will handle both v4 and v3.6 of ifcap
;I $G(FBCNH),'$$VER^FBAAUTL1() D POST^FBAASCB Q
I FBII78["FB583(" D POST Q
;find 7078 entry and build variables needed for call
I '$D(^FB7078(+FBII78,0)) W !,"No 7078 on file for invoice ",J,". Could not determine 1358.",! S FBERR=1 Q
S FBI78=$P(^FB7078(+FBII78,0),"^"),DFN=+$P(^(0),"^",3),FBI78=$P(FZ,"^",8)_"-"_$P(FBI78,".")_"-"_$P(FBI78,".",2) D
.I $D(FBCNH),'$D(^PRC(424,"E",DFN_";"_+FBII78_";"_FBAAON_";"_FBMM)) D POST Q
.D INPOST^FBAASCB0:$$INTER^FBAASCB0()
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAARD3 1126 printed Sep 23, 2025@19:32:28 Page 2
FBAARD3 ;AISC/GRR-VOUCHER AUDIT DELETE REJECTS ENTERED IN ERROR ;3/27/2012
+1 ;;3.5;FEE BASIS;**132**;JAN 30, 1995;Build 17
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;
POST ;entry point to put dollars back into an authorization on the 1358
+1 ;if rejected in error
+2 ;first will locate interface ID from PRC(424,"E",IEN of 161.7)
+3 ;if interface not exist use old call to POST^FBAASCB
+4 ;I '$$VER^FBAAUTL1() D POST^FBAASCB Q
+5 IF '$ORDER(^PRC(424,"E",+$GET(FBN),0))
DO POST^FBAASCB
QUIT
+6 DO ADD^FBAAUTL1
QUIT
+7 ;
INPOST ;call to put money back into 1358 for inpatient invoices
+1 ;call will handle both v4 and v3.6 of ifcap
+2 ;I $G(FBCNH),'$$VER^FBAAUTL1() D POST^FBAASCB Q
+3 IF FBII78["FB583("
DO POST
QUIT
+4 ;find 7078 entry and build variables needed for call
+5 IF '$DATA(^FB7078(+FBII78,0))
WRITE !,"No 7078 on file for invoice ",J,". Could not determine 1358.",!
SET FBERR=1
QUIT
+6 SET FBI78=$PIECE(^FB7078(+FBII78,0),"^")
SET DFN=+$PIECE(^(0),"^",3)
SET FBI78=$PIECE(FZ,"^",8)_"-"_$PIECE(FBI78,".")_"-"_$PIECE(FBI78,".",2)
Begin DoDot:1
+7 IF $DATA(FBCNH)
IF '$DATA(^PRC(424,"E",DFN_";"_+FBII78_";"_FBAAON_";"_FBMM))
DO POST
QUIT
+8 if $$INTER^FBAASCB0()
DO INPOST^FBAASCB0
End DoDot:1
+9 QUIT
