- 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 Jan 18, 2025@02:57:37 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