FBAAIAE ;ALB/FA - ADD/EDIT AN IPAC VENDOR AGREEMENT ;04 Dec 2013 07:27 AM
;;3.5;FEE BASIS;**123**;JAN 30, 1995;Build 51
;;Per VA Directive 6402, this routine should not be modified.
;
;-----------------------------------------------------------------------------
; Entry Points
; ADDEDIT - Add/Edit an IPAC Vendor Agreement
; NOTE: (actually called from first line of routine)
;-----------------------------------------------------------------------------
;
ADDEDIT ;EP
; Add/Edit an IPAC Vendor Agreement
; Called From: Menu - FBAA IPAC AGREEMENT Add/Edit an IPAC agreement
N XX
F S XX=$$ADDEDIT1() Q:XX=1
Q
;
ADDEDIT1() ; Used to loop
; Input: None
; Returns: 1 - User timed out or typed '^' to exit, 0 otherwise
; Called From: ADDEDT
N IX,FLINE,MODE,STEXT,VAEDITED,VAIEN,VASTAT,VASTATO
S FLINE="The following IPAC Agreements are currently on file:"
S STEXT="Please select the IPAC agreement to edit or type NEW to create a new entry"
S MODE=$$SELVA^FBAAIAU(FLINE,STEXT,1,"") ; Select an IPAC Agreement
I MODE="" Q 1 ; User exit
I MODE=0 D ADDVA Q 0 ; Add a new IPAC Agreement
S VAIEN=MODE,MODE=1 ; Edit IPAC agreement
;
; Attempt to lock the IPAC Vendor Agreement file
Q:'$$LOCKVA^FBAAIAU(VAIEN) 0 ; Attempt to lock the Vendor Agreement
;
; Warn the user if the selected agreement is incomplete
S VASTATO=$P(^FBAA(161.95,VAIEN,0),U,4) ; Current Agreement status
I VASTATO="N" D ; Incomplete Vendor Agreement warning
. W !!,"This IPAC Vendor Agreement is not complete. Complete it using this option"
. W !,"or use the IPAC Vendor Agreement delete option to delete it."
;
; Store current Vendor agreement field values
K ^TMP($J,"FBAAIAC")
F IX=0:1:6 S ^TMP($J,"FBAAIAC",IX)=$G(^FBAA(161.95,VAIEN,IX))
D EDITVA1(VAIEN) ; Edit the IPAC Agreement
S VASTAT=$P(^FBAA(161.95,VAIEN,0),U,4) ; Current Agreement status
;
; IPAC Agreement is still incomplete - unlock it and quit
I VASTAT="N" D Q 0
. D UNLOCKVA^FBAAIAU(VAIEN) ; Unlock the Vendor Agreement
. K ^TMP($J,"FBAAIAC")
;
; Check if the status went from N to A - First time agreement is complete
I VASTATO="N",VASTAT="A" D Q 0 ; Send ADD MRA
. D A^FBAAIAQ(VAIEN) ; Create an ADD MRA record
. D UNLOCKVA^FBAAIAU(VAIEN) ; Unlock the Vendor Agreement
. K ^TMP($J,"FBAAIAC")
;
; Check to see if any of the field values were changed
S VAEDITED=0
F IX=0:1:6 D Q:VAEDITED
. I $G(^FBAA(161.95,VAIEN,IX))'=$G(^TMP($J,"FBAAIAC",IX)) S VAEDITED=1
;
; Agreement was edited, create a MRA record for the changes
D:VAEDITED=1 C^FBAAIAQ(VAIEN) ; Send Change MRA
D UNLOCKVA^FBAAIAU(VAIEN) ; Unlock the Vendor Agreement
K ^TMP($J,"FBAAIAC")
Q 0
;
ADDVA ;
; Add a new IPAC Vendor Agreement
; Called From: ADDEDIT
N FYR,VAIEN,VASTAT,VENIEN,XX
S VENIEN=$$VENDSEL() ; Select a Vendor
Q:VENIEN="" ; No Vendor selected
;
; Display any active or new agreements for the selected vendor
Q:'$$DISPVA(VENIEN)
S FYR=$$FYR() ; Ask fiscal year via DIR
;
; Add an IPAC Vendor Agreement for the selected vendor
Q:'$$ADDVA1(VENIEN,FYR,.VAIEN)
S VASTAT=$P(^FBAA(161.95,VAIEN,0),U,4) ; Current Agreement status
D:VASTAT'="N" A^FBAAIAQ(VAIEN) ; Create an ADD MRA record
Q
;
VENDSEL() ; Selects a Vendor to add an agreement for
; Input: None
; Output: None
; Returns: VENIEN - IEN of the selected Vendor or "" if not selected
; Called From: ADDVA
N DA,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,QUIT,VENIEN,X,Y
S DIC="^FBAAV(",DIC(0)="AEQM"
S DIC("A")="Select a Vendor: "
S DIC("S")="I $P($G(^(""AMS"")),""^"",4)=""F""" ; Only Show Federal Vendors
D ^DIC
I Y'>0 Q "" ; No selected Vendor
S VENIEN=+Y,QUIT=0
I $P($G(^FBAAV(VENIEN,"ADEL")),U,1)="Y" D ; Deleted Vendor
. S DIR(0)="Y"
. W !!,"This vendor has been deleted from the Austin vendor database"
. S DIR("A")="Do you wish to continue",DIR("B")="No"
. D ^DIR
. S:Y'>0 QUIT=1
Q:QUIT ""
Q VENIEN
;
FYR() ; Prompt the user for the Fiscal year of the agreement
; Input: None
; Output: None
; Returns: FYR - IEN of the selected Vendor or "" if not selected
; Called From: ADDVA
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,XX,Y,FBCURR,FBMON,FBYR
S DIR(0)="161.95,2"
S FBCURR=$$FMTE^XLFDT(DT,"7D") ; current date
S FBMON=$P(FBCURR,"/",2) ; current month
S FBYR=$P(FBCURR,"/",1) ; current year
I FBMON'<10 S FBYR=FBYR+1 ; for Oct-Dec, Fiscal year is Calendar year+1
S DIR("B")=FBYR
D ^DIR
Q Y
;
DISPVA(VENIEN) ; Display any active or new agreements on file for this vendor
; Input: VENIEN - Selected Vendor IEN
; Output: New/Active agreements for vendor are displayed
; Returns: Selected Vendor or "" if no vendor was de-selected
; Called From: ADDVA
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,FLINE,VAIEN,VASTAT,X,Y
;
; Selected Vendor doesn't have any new or active agreements
I '$D(^FBAA(161.95,"AVA",VENIEN,"A")),'$D(^FBAA(161.95,"AVA",VENIEN,"N")) Q VENIEN
S FLINE="This vendor has the following active IPAC agreement(s) on file:"
D SELVA^FBAAIAU(FLINE,"",0,VENIEN)
W !
S DIR(0)="Y",DIR("A")="Do you wish to continue with this vendor",DIR("B")="No"
D ^DIR
Q:Y'>0 "" ; De-select the vendor
Q VENIEN
;
ADDVA1(VENIEN,FYR,VAIEN) ; Add a new IPAC Vendor agreement for the selected vendor
; Input: VENIEN - Selected Vendor IEN
; FYR - Fiscal Year of the new IPAC agreement
; Output: VAIEN - IEN of the added/edited Vendor agreement
; Vendor agreement is filed for the selected vendor
; Returns: 0 if New entry couldn't be added 1 otherwise
; Called From: ADDVA
N DA,DIC,DIE,DO,DR,DTOUT,VAID,X,Y
Q:'$$LOCKVA 0 ; Lock IPAC Agreement file
S VAID=$$NEXTVAID() ; Last IPAC ID number
D UNLOCKVA ; Unlock Vendor Agreement file
;
; Add a new entry to the IPAC Vendor Agreement file with Identity fields only
; NOTE: if not all the identity fields are added, no agreement is filed
S X=VAID,DIC=161.95
S DIC(0)="Z",DIC("DR")="1////^S X=VENIEN;2///^S X=FYR;3////N"
D FILE^DICN
I (+Y'>0)!($P(Y,U,3)'=1) D Q 0
. W !!," A new IPAC Agreement cannot be filed at this time."
S VAIEN=+Y
S DIE=161.95,DA=VAIEN
S DR="4:16"
D ^DIE
D CHKREQ^FBAAIAU(VAIEN) ; Check the status
Q 1
;
NEXTVAID() ; Increments the last IPAC ID number in the parameter file
; and returns the new value
; Input: None
; Output: Sets the Last IPAC ID number parameter
; Returns: Next Available IPAC ID number
N DA,DR,DIE,DTOUT,VAID
I '$D(^FBAA(161.4,1,"IPAC"))!'$D(^FBAA(161.95)) S VAID=100
E S VAID=^FBAA(161.4,1,"IPAC")
;
; Make sure this is truly the last number and if not, find the last one
S:$D(^FBAA(161.95,"B",VAID)) VAID=$O(^FBAA(161.95,"B",""),-1)
S VAID=VAID+1 ; Get the new 'LAST' ID
S DIE=161.4,DA=1,DR="80///^S X=VAID"
D ^DIE ; File the new last number
Q VAID
;
EDITVA1(VAIEN) ; Edit the selected IPAC Vendor agreement
; Input: VAIEN - IEN of the IPAC Vendor agreement to edit
; Called From: ADDVA
N DA,DIE,DR,DTOUT,INV,VASTAT
S DIE=161.95,DA=VAIEN
S VASTAT=$P(^FBAA(161.95,VAIEN,0),U,4),INV=0
;
; Check for current invoices for the selected agreement
S:$D(^FBAAC("IPAC",VAIEN))!($D(^FBAA(162.1,"IPAC",VAIEN))!($D(^FBAAI("IPAC",VAIEN)))) INV=1
;
; Display Vendor and Fiscal Year but don't allow edit if invoices exist
I INV D
. N FYR,VENDOR
. S VENDOR=$P(^FBAA(161.95,VAIEN,0),"^",2)
. S VENDOR=$E($P(^FBAAV(VENDOR,0),"^",1),1,36)
. S FYR=$P(^FBAA(161.95,VAIEN,0),"^",3)
. W !!,"The IPAC Agreement you have selected has been used on one or more payment "
. W !,"records. Because of this the Vendor and the Fiscal Year are not editable."
. W !!," VENDOR: ",$$LJ^XLFSTR(VENDOR,38),"(No editing allowed)"
. W !,"FISCAL YEAR: ",$$LJ^XLFSTR(FYR,38),"(No editing allowed)",!
S DR=$S('INV:"1:2;",1:"")
S DR=DR_$S(VASTAT'="N":"3:16",1:"4:16")
D ^DIE
D CHKREQ^FBAAIAU(VAIEN) ; Check the status
Q
;
LOCKVA() ; Attempt to lock the Vendor agreement file to add a new agreement
; Input: None
; Output: Vendor agreement file locked or error message displayed
; Returns: 1 - Vendor agreement file locked, 0 otherwise
L +^FBAA(161.95,0):0
I '$T D Q 0
. W !!,"Someone is editing the IPAC Agreement file. Cannot enter a new IPAC agreement"
. W !,"file at this time. Try again at a later time."
Q 1
;
UNLOCKVA() ; Unlock Vendor agreement file
; Input: None
; Output: Vendor agreement file unlocked
L -^FBAA(161.95,0)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAAIAE 9410 printed Sep 23, 2025@19:31:37 Page 2
FBAAIAE ;ALB/FA - ADD/EDIT AN IPAC VENDOR AGREEMENT ;04 Dec 2013 07:27 AM
+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 ; ADDEDIT - Add/Edit an IPAC Vendor Agreement
+7 ; NOTE: (actually called from first line of routine)
+8 ;-----------------------------------------------------------------------------
+9 ;
ADDEDIT ;EP
+1 ; Add/Edit an IPAC Vendor Agreement
+2 ; Called From: Menu - FBAA IPAC AGREEMENT Add/Edit an IPAC agreement
+3 NEW XX
+4 FOR
SET XX=$$ADDEDIT1()
if XX=1
QUIT
+5 QUIT
+6 ;
ADDEDIT1() ; Used to loop
+1 ; Input: None
+2 ; Returns: 1 - User timed out or typed '^' to exit, 0 otherwise
+3 ; Called From: ADDEDT
+4 NEW IX,FLINE,MODE,STEXT,VAEDITED,VAIEN,VASTAT,VASTATO
+5 SET FLINE="The following IPAC Agreements are currently on file:"
+6 SET STEXT="Please select the IPAC agreement to edit or type NEW to create a new entry"
+7 ; Select an IPAC Agreement
SET MODE=$$SELVA^FBAAIAU(FLINE,STEXT,1,"")
+8 ; User exit
IF MODE=""
QUIT 1
+9 ; Add a new IPAC Agreement
IF MODE=0
DO ADDVA
QUIT 0
+10 ; Edit IPAC agreement
SET VAIEN=MODE
SET MODE=1
+11 ;
+12 ; Attempt to lock the IPAC Vendor Agreement file
+13 ; Attempt to lock the Vendor Agreement
if '$$LOCKVA^FBAAIAU(VAIEN)
QUIT 0
+14 ;
+15 ; Warn the user if the selected agreement is incomplete
+16 ; Current Agreement status
SET VASTATO=$PIECE(^FBAA(161.95,VAIEN,0),U,4)
+17 ; Incomplete Vendor Agreement warning
IF VASTATO="N"
Begin DoDot:1
+18 WRITE !!,"This IPAC Vendor Agreement is not complete. Complete it using this option"
+19 WRITE !,"or use the IPAC Vendor Agreement delete option to delete it."
End DoDot:1
+20 ;
+21 ; Store current Vendor agreement field values
+22 KILL ^TMP($JOB,"FBAAIAC")
+23 FOR IX=0:1:6
SET ^TMP($JOB,"FBAAIAC",IX)=$GET(^FBAA(161.95,VAIEN,IX))
+24 ; Edit the IPAC Agreement
DO EDITVA1(VAIEN)
+25 ; Current Agreement status
SET VASTAT=$PIECE(^FBAA(161.95,VAIEN,0),U,4)
+26 ;
+27 ; IPAC Agreement is still incomplete - unlock it and quit
+28 IF VASTAT="N"
Begin DoDot:1
+29 ; Unlock the Vendor Agreement
DO UNLOCKVA^FBAAIAU(VAIEN)
+30 KILL ^TMP($JOB,"FBAAIAC")
End DoDot:1
QUIT 0
+31 ;
+32 ; Check if the status went from N to A - First time agreement is complete
+33 ; Send ADD MRA
IF VASTATO="N"
IF VASTAT="A"
Begin DoDot:1
+34 ; Create an ADD MRA record
DO A^FBAAIAQ(VAIEN)
+35 ; Unlock the Vendor Agreement
DO UNLOCKVA^FBAAIAU(VAIEN)
+36 KILL ^TMP($JOB,"FBAAIAC")
End DoDot:1
QUIT 0
+37 ;
+38 ; Check to see if any of the field values were changed
+39 SET VAEDITED=0
+40 FOR IX=0:1:6
Begin DoDot:1
+41 IF $GET(^FBAA(161.95,VAIEN,IX))'=$GET(^TMP($JOB,"FBAAIAC",IX))
SET VAEDITED=1
End DoDot:1
if VAEDITED
QUIT
+42 ;
+43 ; Agreement was edited, create a MRA record for the changes
+44 ; Send Change MRA
if VAEDITED=1
DO C^FBAAIAQ(VAIEN)
+45 ; Unlock the Vendor Agreement
DO UNLOCKVA^FBAAIAU(VAIEN)
+46 KILL ^TMP($JOB,"FBAAIAC")
+47 QUIT 0
+48 ;
ADDVA ;
+1 ; Add a new IPAC Vendor Agreement
+2 ; Called From: ADDEDIT
+3 NEW FYR,VAIEN,VASTAT,VENIEN,XX
+4 ; Select a Vendor
SET VENIEN=$$VENDSEL()
+5 ; No Vendor selected
if VENIEN=""
QUIT
+6 ;
+7 ; Display any active or new agreements for the selected vendor
+8 if '$$DISPVA(VENIEN)
QUIT
+9 ; Ask fiscal year via DIR
SET FYR=$$FYR()
+10 ;
+11 ; Add an IPAC Vendor Agreement for the selected vendor
+12 if '$$ADDVA1(VENIEN,FYR,.VAIEN)
QUIT
+13 ; Current Agreement status
SET VASTAT=$PIECE(^FBAA(161.95,VAIEN,0),U,4)
+14 ; Create an ADD MRA record
if VASTAT'="N"
DO A^FBAAIAQ(VAIEN)
+15 QUIT
+16 ;
VENDSEL() ; Selects a Vendor to add an agreement for
+1 ; Input: None
+2 ; Output: None
+3 ; Returns: VENIEN - IEN of the selected Vendor or "" if not selected
+4 ; Called From: ADDVA
+5 NEW DA,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,QUIT,VENIEN,X,Y
+6 SET DIC="^FBAAV("
SET DIC(0)="AEQM"
+7 SET DIC("A")="Select a Vendor: "
+8 ; Only Show Federal Vendors
SET DIC("S")="I $P($G(^(""AMS"")),""^"",4)=""F"""
+9 DO ^DIC
+10 ; No selected Vendor
IF Y'>0
QUIT ""
+11 SET VENIEN=+Y
SET QUIT=0
+12 ; Deleted Vendor
IF $PIECE($GET(^FBAAV(VENIEN,"ADEL")),U,1)="Y"
Begin DoDot:1
+13 SET DIR(0)="Y"
+14 WRITE !!,"This vendor has been deleted from the Austin vendor database"
+15 SET DIR("A")="Do you wish to continue"
SET DIR("B")="No"
+16 DO ^DIR
+17 if Y'>0
SET QUIT=1
End DoDot:1
+18 if QUIT
QUIT ""
+19 QUIT VENIEN
+20 ;
FYR() ; Prompt the user for the Fiscal year of the agreement
+1 ; Input: None
+2 ; Output: None
+3 ; Returns: FYR - IEN of the selected Vendor or "" if not selected
+4 ; Called From: ADDVA
+5 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,XX,Y,FBCURR,FBMON,FBYR
+6 SET DIR(0)="161.95,2"
+7 ; current date
SET FBCURR=$$FMTE^XLFDT(DT,"7D")
+8 ; current month
SET FBMON=$PIECE(FBCURR,"/",2)
+9 ; current year
SET FBYR=$PIECE(FBCURR,"/",1)
+10 ; for Oct-Dec, Fiscal year is Calendar year+1
IF FBMON'<10
SET FBYR=FBYR+1
+11 SET DIR("B")=FBYR
+12 DO ^DIR
+13 QUIT Y
+14 ;
DISPVA(VENIEN) ; Display any active or new agreements on file for this vendor
+1 ; Input: VENIEN - Selected Vendor IEN
+2 ; Output: New/Active agreements for vendor are displayed
+3 ; Returns: Selected Vendor or "" if no vendor was de-selected
+4 ; Called From: ADDVA
+5 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,FLINE,VAIEN,VASTAT,X,Y
+6 ;
+7 ; Selected Vendor doesn't have any new or active agreements
+8 IF '$DATA(^FBAA(161.95,"AVA",VENIEN,"A"))
IF '$DATA(^FBAA(161.95,"AVA",VENIEN,"N"))
QUIT VENIEN
+9 SET FLINE="This vendor has the following active IPAC agreement(s) on file:"
+10 DO SELVA^FBAAIAU(FLINE,"",0,VENIEN)
+11 WRITE !
+12 SET DIR(0)="Y"
SET DIR("A")="Do you wish to continue with this vendor"
SET DIR("B")="No"
+13 DO ^DIR
+14 ; De-select the vendor
if Y'>0
QUIT ""
+15 QUIT VENIEN
+16 ;
ADDVA1(VENIEN,FYR,VAIEN) ; Add a new IPAC Vendor agreement for the selected vendor
+1 ; Input: VENIEN - Selected Vendor IEN
+2 ; FYR - Fiscal Year of the new IPAC agreement
+3 ; Output: VAIEN - IEN of the added/edited Vendor agreement
+4 ; Vendor agreement is filed for the selected vendor
+5 ; Returns: 0 if New entry couldn't be added 1 otherwise
+6 ; Called From: ADDVA
+7 NEW DA,DIC,DIE,DO,DR,DTOUT,VAID,X,Y
+8 ; Lock IPAC Agreement file
if '$$LOCKVA
QUIT 0
+9 ; Last IPAC ID number
SET VAID=$$NEXTVAID()
+10 ; Unlock Vendor Agreement file
DO UNLOCKVA
+11 ;
+12 ; Add a new entry to the IPAC Vendor Agreement file with Identity fields only
+13 ; NOTE: if not all the identity fields are added, no agreement is filed
+14 SET X=VAID
SET DIC=161.95
+15 SET DIC(0)="Z"
SET DIC("DR")="1////^S X=VENIEN;2///^S X=FYR;3////N"
+16 DO FILE^DICN
+17 IF (+Y'>0)!($PIECE(Y,U,3)'=1)
Begin DoDot:1
+18 WRITE !!," A new IPAC Agreement cannot be filed at this time."
End DoDot:1
QUIT 0
+19 SET VAIEN=+Y
+20 SET DIE=161.95
SET DA=VAIEN
+21 SET DR="4:16"
+22 DO ^DIE
+23 ; Check the status
DO CHKREQ^FBAAIAU(VAIEN)
+24 QUIT 1
+25 ;
NEXTVAID() ; Increments the last IPAC ID number in the parameter file
+1 ; and returns the new value
+2 ; Input: None
+3 ; Output: Sets the Last IPAC ID number parameter
+4 ; Returns: Next Available IPAC ID number
+5 NEW DA,DR,DIE,DTOUT,VAID
+6 IF '$DATA(^FBAA(161.4,1,"IPAC"))!'$DATA(^FBAA(161.95))
SET VAID=100
+7 IF '$TEST
SET VAID=^FBAA(161.4,1,"IPAC")
+8 ;
+9 ; Make sure this is truly the last number and if not, find the last one
+10 if $DATA(^FBAA(161.95,"B",VAID))
SET VAID=$ORDER(^FBAA(161.95,"B",""),-1)
+11 ; Get the new 'LAST' ID
SET VAID=VAID+1
+12 SET DIE=161.4
SET DA=1
SET DR="80///^S X=VAID"
+13 ; File the new last number
DO ^DIE
+14 QUIT VAID
+15 ;
EDITVA1(VAIEN) ; Edit the selected IPAC Vendor agreement
+1 ; Input: VAIEN - IEN of the IPAC Vendor agreement to edit
+2 ; Called From: ADDVA
+3 NEW DA,DIE,DR,DTOUT,INV,VASTAT
+4 SET DIE=161.95
SET DA=VAIEN
+5 SET VASTAT=$PIECE(^FBAA(161.95,VAIEN,0),U,4)
SET INV=0
+6 ;
+7 ; Check for current invoices for the selected agreement
+8 if $DATA(^FBAAC("IPAC",VAIEN))!($DATA(^FBAA(162.1,"IPAC",VAIEN))!($DATA(^FBAAI("IPAC",VAIEN))))
SET INV=1
+9 ;
+10 ; Display Vendor and Fiscal Year but don't allow edit if invoices exist
+11 IF INV
Begin DoDot:1
+12 NEW FYR,VENDOR
+13 SET VENDOR=$PIECE(^FBAA(161.95,VAIEN,0),"^",2)
+14 SET VENDOR=$EXTRACT($PIECE(^FBAAV(VENDOR,0),"^",1),1,36)
+15 SET FYR=$PIECE(^FBAA(161.95,VAIEN,0),"^",3)
+16 WRITE !!,"The IPAC Agreement you have selected has been used on one or more payment "
+17 WRITE !,"records. Because of this the Vendor and the Fiscal Year are not editable."
+18 WRITE !!," VENDOR: ",$$LJ^XLFSTR(VENDOR,38),"(No editing allowed)"
+19 WRITE !,"FISCAL YEAR: ",$$LJ^XLFSTR(FYR,38),"(No editing allowed)",!
End DoDot:1
+20 SET DR=$SELECT('INV:"1:2;",1:"")
+21 SET DR=DR_$SELECT(VASTAT'="N":"3:16",1:"4:16")
+22 DO ^DIE
+23 ; Check the status
DO CHKREQ^FBAAIAU(VAIEN)
+24 QUIT
+25 ;
LOCKVA() ; Attempt to lock the Vendor agreement file to add a new agreement
+1 ; Input: None
+2 ; Output: Vendor agreement file locked or error message displayed
+3 ; Returns: 1 - Vendor agreement file locked, 0 otherwise
+4 LOCK +^FBAA(161.95,0):0
+5 IF '$TEST
Begin DoDot:1
+6 WRITE !!,"Someone is editing the IPAC Agreement file. Cannot enter a new IPAC agreement"
+7 WRITE !,"file at this time. Try again at a later time."
End DoDot:1
QUIT 0
+8 QUIT 1
+9 ;
UNLOCKVA() ; Unlock Vendor agreement file
+1 ; Input: None
+2 ; Output: Vendor agreement file unlocked
+3 LOCK -^FBAA(161.95,0)
+4 QUIT
+5 ;
