FBAAIAD ;ALB/FA - DELETE AN IPAC AGREEMENT ;03 Dec 2013 2:10 PM
;;3.5;FEE BASIS;**123**;JAN 30, 1995;Build 51
;;Per VA Directive 6402, this routine should not be modified.
;
;-----------------------------------------------------------------------------
; Entry Points
; ISEL - Delete the specified IPAC Vendor Agreement
; NOTE: (actually called from first line of routine)
;-----------------------------------------------------------------------------
;
ISEL ;EP
; Delete the specified IPAC Vendor Agreement
; Input: None
; Output: IPAC Vendor agreement deleted (potentially)
; Called From: Menu - FBAA IPAC AGREEMENT Delete an IPAC agreement
N XX
F S XX=$$ISEL1() Q:XX=1
Q
;
ISEL1() ;
; Input: None
; Returns: 1 - User timed out or typed '^' to exit, 0 otherwise
; Called From: ISEL
N EOUT,FLINE,STEXT,VAIEN,XX
S FLINE="The following IPAC Agreements are currently on file:"
S STEXT="Please select the IPAC agreement to delete"
S VAIEN=$$SELVA^FBAAIAU(FLINE,STEXT,0,"") ; Select an IPAC Agreement
I VAIEN="" Q 1 ; User exit
;
; Check for current invoices for the selected agreement
I $D(^FBAAC("IPAC",VAIEN))!($D(^FBAA(162.1,"IPAC",VAIEN))!($D(^FBAAI("IPAC",VAIEN)))) D Q EOUT
. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
. W !!,"This IPAC agreement has invoice activity associated with it"
. W !,"and cannot be deleted.",!
. S EOUT=0
. S DIR(0)="E"
. D ^DIR
. S:$D(DTOUT)!$D(DUOUT) EOUT=1 ; User timed out or pressed '^'
;
S XX=$$ASKDISP(VAIEN) ; Ask to display the agreement
I XX=-1 Q 1 ; User timeout or '^'
I XX D ; Display the agreement
. W !!
. D VADISP^FBAAIAU(VAIEN,1)
. W !
S XX=$$ASKSURE(VAIEN) ; Final verification before delete attempt
I XX=-1 Q 1 ; User timeout or '^'
Q:'XX 0 ; User chose not to delete
Q:'$$LOCKVA^FBAAIAU(VAIEN) 0 ; Attempt to lock the Vendor Agreement
D DEL(VAIEN) ; Perform the actual deletion
D UNLOCKVA^FBAAIAU(VAIEN) ; Unlock the deleted agreement
Q 0
;
ASKDISP(VAIEN) ; Ask the user if they want to see the agreement details
; Input: VAIEN - IEN of the selected Vendor agreement
; Output: User is prompted to display the agreement
; Returns: 1 - User wants to display the agreement
; 0 - User doesn't want to display the agreement
; -1 - User timed out or typed '^'
; Called From: ISEL
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="Y",DIR("A")="Display this IPAC Vendor Agreement",DIR("B")="No"
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q -1 ; User timed out or pressed '^'
Q:Y'>0 0
Q Y
;
ASKSURE(VAIEN) ; Make sure the user selected the correct Vendor agreement
; Input: VAIEN - IEN of the selected vendor agreement
; Output: User is prompted again
; Returns: 1 - User verifies deletion
; 0 - User chose not to delete
; -1 - User timed out or typed '^'
; Called From: ISEL
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="Y",DIR("A")="Delete this IPAC Vendor Agreement",DIR("B")="No"
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q -1 ; User timed out or pressed '^'
Q:Y'>0 0
Q Y
;
DEL(VAIEN) ; Perform the actual Vendor agreement deletion
; Input: VAIEN - IEN of the selected vendor agreement
; Output: Selected Vendor Agreement and its Master Record Adjustment are deleted
; Called From: ISEL
N DA,DIK,VAID,VASTAT
S DA=VAIEN,DIK="^FBAA(161.95,"
S VASTAT=$P(^FBAA(161.95,VAIEN,0),U,4) ; Current Agreement Status
;
S VAID=$P(^FBAA(161.95,VAIEN,0),U,1) ; Vendor Agreement ID
D ^DIK ; Delete the Vendor Agreement
Q:(VASTAT="N")!(VASTAT="") ; No MRA to delete
D D^FBAAIAQ(VAID) ; Create a Delete MRA record
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAAIAD 4257 printed Sep 23, 2025@19:31:36 Page 2
FBAAIAD ;ALB/FA - DELETE AN IPAC AGREEMENT ;03 Dec 2013 2:10 PM
+1 ;;3.5;FEE BASIS;**123**;JAN 30, 1995;Build 51
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;-----------------------------------------------------------------------------
+5 ; Entry Points
+6 ; ISEL - Delete the specified IPAC Vendor Agreement
+7 ; NOTE: (actually called from first line of routine)
+8 ;-----------------------------------------------------------------------------
+9 ;
ISEL ;EP
+1 ; Delete the specified IPAC Vendor Agreement
+2 ; Input: None
+3 ; Output: IPAC Vendor agreement deleted (potentially)
+4 ; Called From: Menu - FBAA IPAC AGREEMENT Delete an IPAC agreement
+5 NEW XX
+6 FOR
SET XX=$$ISEL1()
if XX=1
QUIT
+7 QUIT
+8 ;
ISEL1() ;
+1 ; Input: None
+2 ; Returns: 1 - User timed out or typed '^' to exit, 0 otherwise
+3 ; Called From: ISEL
+4 NEW EOUT,FLINE,STEXT,VAIEN,XX
+5 SET FLINE="The following IPAC Agreements are currently on file:"
+6 SET STEXT="Please select the IPAC agreement to delete"
+7 ; Select an IPAC Agreement
SET VAIEN=$$SELVA^FBAAIAU(FLINE,STEXT,0,"")
+8 ; User exit
IF VAIEN=""
QUIT 1
+9 ;
+10 ; Check for current invoices for the selected agreement
+11 IF $DATA(^FBAAC("IPAC",VAIEN))!($DATA(^FBAA(162.1,"IPAC",VAIEN))!($DATA(^FBAAI("IPAC",VAIEN))))
Begin DoDot:1
+12 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+13 WRITE !!,"This IPAC agreement has invoice activity associated with it"
+14 WRITE !,"and cannot be deleted.",!
+15 SET EOUT=0
+16 SET DIR(0)="E"
+17 DO ^DIR
+18 ; User timed out or pressed '^'
if $DATA(DTOUT)!$DATA(DUOUT)
SET EOUT=1
End DoDot:1
QUIT EOUT
+19 ;
+20 ; Ask to display the agreement
SET XX=$$ASKDISP(VAIEN)
+21 ; User timeout or '^'
IF XX=-1
QUIT 1
+22 ; Display the agreement
IF XX
Begin DoDot:1
+23 WRITE !!
+24 DO VADISP^FBAAIAU(VAIEN,1)
+25 WRITE !
End DoDot:1
+26 ; Final verification before delete attempt
SET XX=$$ASKSURE(VAIEN)
+27 ; User timeout or '^'
IF XX=-1
QUIT 1
+28 ; User chose not to delete
if 'XX
QUIT 0
+29 ; Attempt to lock the Vendor Agreement
if '$$LOCKVA^FBAAIAU(VAIEN)
QUIT 0
+30 ; Perform the actual deletion
DO DEL(VAIEN)
+31 ; Unlock the deleted agreement
DO UNLOCKVA^FBAAIAU(VAIEN)
+32 QUIT 0
+33 ;
ASKDISP(VAIEN) ; Ask the user if they want to see the agreement details
+1 ; Input: VAIEN - IEN of the selected Vendor agreement
+2 ; Output: User is prompted to display the agreement
+3 ; Returns: 1 - User wants to display the agreement
+4 ; 0 - User doesn't want to display the agreement
+5 ; -1 - User timed out or typed '^'
+6 ; Called From: ISEL
+7 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+8 SET DIR(0)="Y"
SET DIR("A")="Display this IPAC Vendor Agreement"
SET DIR("B")="No"
+9 DO ^DIR
+10 ; User timed out or pressed '^'
IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT -1
+11 if Y'>0
QUIT 0
+12 QUIT Y
+13 ;
ASKSURE(VAIEN) ; Make sure the user selected the correct Vendor agreement
+1 ; Input: VAIEN - IEN of the selected vendor agreement
+2 ; Output: User is prompted again
+3 ; Returns: 1 - User verifies deletion
+4 ; 0 - User chose not to delete
+5 ; -1 - User timed out or typed '^'
+6 ; Called From: ISEL
+7 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+8 SET DIR(0)="Y"
SET DIR("A")="Delete this IPAC Vendor Agreement"
SET DIR("B")="No"
+9 DO ^DIR
+10 ; User timed out or pressed '^'
IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT -1
+11 if Y'>0
QUIT 0
+12 QUIT Y
+13 ;
DEL(VAIEN) ; Perform the actual Vendor agreement deletion
+1 ; Input: VAIEN - IEN of the selected vendor agreement
+2 ; Output: Selected Vendor Agreement and its Master Record Adjustment are deleted
+3 ; Called From: ISEL
+4 NEW DA,DIK,VAID,VASTAT
+5 SET DA=VAIEN
SET DIK="^FBAA(161.95,"
+6 ; Current Agreement Status
SET VASTAT=$PIECE(^FBAA(161.95,VAIEN,0),U,4)
+7 ;
+8 ; Vendor Agreement ID
SET VAID=$PIECE(^FBAA(161.95,VAIEN,0),U,1)
+9 ; Delete the Vendor Agreement
DO ^DIK
+10 ; No MRA to delete
if (VASTAT="N")!(VASTAT="")
QUIT
+11 ; Create a Delete MRA record
DO D^FBAAIAQ(VAID)
+12 QUIT
