FBAAODP ;AISC/GRR - DELETE PAYMENT ;11/13/2014
;;3.5;FEE BASIS;**154**;JAN 30, 1995;Build 12
;;Per VA Directive 6402, this routine should not be modified.
S:'$D(^FBAAC(DFN,1,0)) ^FBAAC(DFN,1,0)="^162.01P^0^0"
RDV W !! S DIC="^FBAAC("_DFN_",1,",DIC(0)="AEQM",DA(1)=DFN D ^DIC G Q:X="^"!(X=""),RDV:Y<0 S (FBV,DA)=+Y
I '$D(^FBAAC(DFN,FBV,"AD")) W !,"Vendor has no prior claims",! G RDV
D EN1^FBAAVS
RDATE K FBSDI,FBAACPI W !! I '$D(^FBAAC(DFN,1,FBV,1,0)) S ^FBAAC(DFN,1,FBV,1,0)="^162.02DA^0^0"
S DA(2)=DFN,DA(1)=FBV,DIC(0)="AEQM",DIC("A")="Date of Service: ",DIC="^FBAAC("_DFN_",1,"_FBV_",1," D ^DIC K DIC,DA G RDV:X="^"!(X=""),RDATE:Y<0 S FBSDI=+Y,FBAADT=$P(Y,"^",2)
I '$D(^FBAAC(DFN,1,FBV,1,FBSDI,1,0)) S ^FBAAC(DFN,1,FBV,1,FBSDI,1,0)="^162.03A^0^0"
LOOK G CHKE
Q K FBAADT,FBX,FBAACP,FBAAOBN,FBAAODUZ,FBAAOPA,FBAACPI,FBSDI,FBMOD Q
CHKE S DIC="^FBAAC("_DFN_",1,"_FBV_",1,"_FBSDI_",1,",DIC(0)="AEQM",DA(3)=DFN,DA(2)=FBV,DA(1)=FBSDI D ^DIC Q:X=""!(X="^") G RDATE:Y<0 S (FBAACPI,DA)=+Y D SETO
I FBAABE'=FBAAOBN W !,*7,"Sorry, that payment is not in the Batch you selected!",*7 G RDATE
; enforce segregation of duties
S FTP(0)=$P($G(^FBAAC(DA(3),1,DA(2),1,DA(1),1,DA,3)),U,9)
I '$$UOKPAY^FBUTL9(DFN,FTP(0)) D G RDATE
. W !!,"You cannot process a payment associated with authorization ",DFN,"-",FTP(0)
. W !,"due to separation of duties."
;
RD W ! S DIR("A")="Are you sure you want to delete this payment record",DIR("B")="No",DIR(0)="Y" D ^DIR K DIR Q:$D(DIRUT) I 'Y G RDATE
S DIK=DIC D ^DIK D K A,B,J,K W !,"Payment record Deleted!",! G RDATE
.; reset batch total and line count
. I +$G(FBAABE) N DA,FBTOTAL,FBLCNT D CNTTOT^FBAARB(+FBAABE) D
..S DA=+FBAABE,DIE="^FBAA(161.7,",DR="10////^S X=FBLCNT;8////^S X=FBTOTAL;S:FBLCNT!(FBTOTAL) Y="""";9///@" D ^DIE K DIE,DR
..S:FBTOTAL=0 $P(^FBAA(161.7,+FBAABE,0),U,9)=""
..S:FBLCNT=0 $P(^FBAA(161.7,+FBAABE,0),U,11)=""
Q
SETO S FBAAOPA=$S($P(Y,"^",3)=1:0,$D(^FBAAC(DA(3),1,DA(2),1,DA(1),1,DA,0)):$P(^(0),"^",3),1:0),FBAAODUZ=$P(^(0),"^",7),FBAAOBN=$P(^(0),"^",8)
S FY=$E(FBAADT,1,3)+1700+$S($E(FBAADT,4,5)>9:1,1:0)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAAODP 2113 printed Sep 23, 2025@19:31:56 Page 2
FBAAODP ;AISC/GRR - DELETE PAYMENT ;11/13/2014
+1 ;;3.5;FEE BASIS;**154**;JAN 30, 1995;Build 12
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 if '$DATA(^FBAAC(DFN,1,0))
SET ^FBAAC(DFN,1,0)="^162.01P^0^0"
RDV WRITE !!
SET DIC="^FBAAC("_DFN_",1,"
SET DIC(0)="AEQM"
SET DA(1)=DFN
DO ^DIC
if X="^"!(X="")
GOTO Q
if Y<0
GOTO RDV
SET (FBV,DA)=+Y
+1 IF '$DATA(^FBAAC(DFN,FBV,"AD"))
WRITE !,"Vendor has no prior claims",!
GOTO RDV
+2 DO EN1^FBAAVS
RDATE KILL FBSDI,FBAACPI
WRITE !!
IF '$DATA(^FBAAC(DFN,1,FBV,1,0))
SET ^FBAAC(DFN,1,FBV,1,0)="^162.02DA^0^0"
+1 SET DA(2)=DFN
SET DA(1)=FBV
SET DIC(0)="AEQM"
SET DIC("A")="Date of Service: "
SET DIC="^FBAAC("_DFN_",1,"_FBV_",1,"
DO ^DIC
KILL DIC,DA
if X="^"!(X="")
GOTO RDV
if Y<0
GOTO RDATE
SET FBSDI=+Y
SET FBAADT=$PIECE(Y,"^",2)
+2 IF '$DATA(^FBAAC(DFN,1,FBV,1,FBSDI,1,0))
SET ^FBAAC(DFN,1,FBV,1,FBSDI,1,0)="^162.03A^0^0"
LOOK GOTO CHKE
Q KILL FBAADT,FBX,FBAACP,FBAAOBN,FBAAODUZ,FBAAOPA,FBAACPI,FBSDI,FBMOD
QUIT
CHKE SET DIC="^FBAAC("_DFN_",1,"_FBV_",1,"_FBSDI_",1,"
SET DIC(0)="AEQM"
SET DA(3)=DFN
SET DA(2)=FBV
SET DA(1)=FBSDI
DO ^DIC
if X=""!(X="^")
QUIT
if Y<0
GOTO RDATE
SET (FBAACPI,DA)=+Y
DO SETO
+1 IF FBAABE'=FBAAOBN
WRITE !,*7,"Sorry, that payment is not in the Batch you selected!",*7
GOTO RDATE
+2 ; enforce segregation of duties
+3 SET FTP(0)=$PIECE($GET(^FBAAC(DA(3),1,DA(2),1,DA(1),1,DA,3)),U,9)
+4 IF '$$UOKPAY^FBUTL9(DFN,FTP(0))
Begin DoDot:1
+5 WRITE !!,"You cannot process a payment associated with authorization ",DFN,"-",FTP(0)
+6 WRITE !,"due to separation of duties."
End DoDot:1
GOTO RDATE
+7 ;
RD WRITE !
SET DIR("A")="Are you sure you want to delete this payment record"
SET DIR("B")="No"
SET DIR(0)="Y"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
IF 'Y
GOTO RDATE
+1 SET DIK=DIC
DO ^DIK
Begin DoDot:1
+2 ; reset batch total and line count
+3 IF +$GET(FBAABE)
NEW DA,FBTOTAL,FBLCNT
DO CNTTOT^FBAARB(+FBAABE)
Begin DoDot:2
+4 SET DA=+FBAABE
SET DIE="^FBAA(161.7,"
SET DR="10////^S X=FBLCNT;8////^S X=FBTOTAL;S:FBLCNT!(FBTOTAL) Y="""";9///@"
DO ^DIE
KILL DIE,DR
+5 if FBTOTAL=0
SET $PIECE(^FBAA(161.7,+FBAABE,0),U,9)=""
+6 if FBLCNT=0
SET $PIECE(^FBAA(161.7,+FBAABE,0),U,11)=""
End DoDot:2
End DoDot:1
KILL A,B,J,K
WRITE !,"Payment record Deleted!",!
GOTO RDATE
+7 QUIT
SETO SET FBAAOPA=$SELECT($PIECE(Y,"^",3)=1:0,$DATA(^FBAAC(DA(3),1,DA(2),1,DA(1),1,DA,0)):$PIECE(^(0),"^",3),1:0)
SET FBAAODUZ=$PIECE(^(0),"^",7)
SET FBAAOBN=$PIECE(^(0),"^",8)
+1 SET FY=$EXTRACT(FBAADT,1,3)+1700+$SELECT($EXTRACT(FBAADT,4,5)>9:1,1:0)
+2 QUIT
