Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FBAAIAU

FBAAIAU.m

Go to the documentation of this file. 
  1. FBAAIAU ;ALB/FA - BUILD C8 MESSAGE ;03 Dec 2013  9:34 AM
  1.  ;;3.5;FEE BASIS;**123**;JAN 30, 1995;Build 51
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; Contains utility functions for IPAC Vendor Agreement Management
  1.  ;
  1.  ;-----------------------------------------------------------------------------
  1.  ;                           Methods
  1.  ; CHKREQ       - Makes sure that all the required fields of the IPAC Vendor
  1.  ;                agreement have values and if they do, changes the status of
  1.  ;                the agreement to 'A'
  1.  ; DELALL       - Delete all Vendor Agreements (161.95) and MRAs (161.96)
  1.  ; LOCKVA       - Attempts to lock a specified IPAC Vendor Agreement
  1.  ; SELMRA       - Displays a list of all the current MRA records and allows the
  1.  ;                user to select one
  1.  ; SELVA        - Displays a list of all the current IPAC Vendor Agreements and
  1.  ;                allows the user to either select one to be edited or type 'NEW'
  1.  ;                to enter a new one
  1.  ; VADISP       - Returns the IPAC Vendor Agreement Display Layout for a 
  1.  ;                specified vendor agreement
  1.  ; VALOAD       - Returns an array of external field values for a specified
  1.  ;                Vendor Agreement
  1.  ; UNLOCKVA     - Unlocks a specified IPAC Vendor Agreement
  1.  ;-----------------------------------------------------------------------------
  1.  ;
  1. CHKREQ(VAIEN)   ;EP
  1.  ; Checks to see if all of the required fields of the IPAC vendor agreement have
  1.  ; been entered and if so, change the status of the agreement to 'A' 
  1.  ; Input:       VAIEN       - IEN of the IPAC Vendor agreement to be checked
  1.  ; Called From: FBAAIAE, FBAAIAC
  1.  ; NOTE:        Quits if the current status of the agreement is not 'N' without
  1.  ;              doing anything. Also, the fields of the Vendor agreement are
  1.  ;              HARD CODED in this method - if a new required field is added this
  1.  ;              method must be modified
  1.  N ARR,ERR,DA,DIE,DR,DTOUT,FLD,FLDINFO,NDE,PCE,STOP
  1.  Q:'$D(^FBAA(161.95,VAIEN,0))                       ; Invalid IPAC agreement IEN
  1.  Q:$P(^FBAA(161.95,VAIEN,0),U,4)'="N"               ; Status isn't 'N'
  1.  ;
  1.  ; First get a list of all the required fields
  1.  F FLD=1:1:16,7.5 D                                 ; NOTE: HARD CODED field list
  1.  . D FIELD^DID(161.95,FLD,,"GLOBAL SUBSCRIPT LOCATION;SPECIFIER","ARR","ERR")
  1.  . Q:$E(ARR("SPECIFIER"),1)'="R"                    ; Not a required field
  1.  . S FLDINFO(FLD)=ARR("GLOBAL SUBSCRIPT LOCATION")  ; Node;Piece 
  1.  ;
  1.  ; Now loop Through all of the required fields and check for data
  1.  S FLD=0,STOP=0
  1.  F  D  Q:FLD=""  Q:STOP
  1.  . S FLD=$O(FLDINFO(FLD))
  1.  . Q:FLD=""
  1.  . S NDE=$P(FLDINFO(FLD),";",1),PCE=$P(FLDINFO(FLD),";",2)
  1.  . S:$P($G(^FBAA(161.95,VAIEN,NDE)),U,PCE)="" STOP=1    ; Missing required field
  1.  Q:STOP
  1.  ;
  1.  S DIE=161.95,DA=VAIEN
  1.  S DR="3////A"
  1.  D ^DIE
  1.  Q
  1.  ;
  1. DELALL ;EP
  1.  ; Clean-up utility to delete all existing Vendor agreements and MRA records
  1.  ; Input:    None
  1.  ; Output:   ^FBAA(161.95) AND ^FBAA(161.96) are cleared
  1.  N DA,DIE,DIK,DR,DTOUT
  1.  S DIK="^FBAA(161.95,"
  1.  S DA=0
  1.  F  D  Q:DA=""
  1.  . S DA=$O(^FBAA(161.95,DA))
  1.  . Q:DA=""
  1.  . D ^DIK
  1.  ;
  1.  S DIK="^FBAA(161.96,"
  1.  S DA=0
  1.  F  D  Q:DA=""
  1.  . S DA=$O(^FBAA(161.96,DA))
  1.  . Q:DA=""
  1.  . D ^DIK
  1.  ;
  1.  ; Reset the Last IPAC number
  1.  S DIE=161.4,DA=1,DR="80///100"
  1.  D ^DIE                                         ; File the new last number
  1.  Q
  1.  ;
  1. SELVA(FLINE,STEXT,NEW,SVENIEN) ;EP
  1.  ; Displays all of the currently filed IPAC Vendor agreements and allows the user
  1.  ; to select one to edit or type 'NEW' to enter a new one
  1.  ; Input:   FLINE       - Text of the first line to be displayed
  1.  ;          STEXT       - User Selection prompt to be displayed
  1.  ;                        NOTE: "" is allowed here.  If null, this becomes a 
  1.  ;                              display only method with no ability select a Vendor
  1.  ;                              OR to type NEW to enter a new one
  1.  ;          NEW         - 1 to allow NEW as a valid selection, 0 otherwise
  1.  ;          SVENIEN     - IEN of a specified vendor
  1.  ;                        Optional, if specified, only IPAC agreements for the
  1.  ;                        specified vendor will be displayed
  1.  ; Output:  Current IPAC Vendor agreements displayed to the screen, if there are none,
  1.  ;          a message is displayed
  1.  ; Returns: VAIEN       - IEN of the selected IPAC Agreement
  1.  ;                        0  - User wants/needs to enter a new agreement
  1.  ;                        "" - No IPAC Vendor Agreement was selected
  1.  N CNT,LN,DIR,DIROUT,DIRUT,DTOUT,DUOUT,IX,OUT,VADATA,VAIEN,VENIEN,X,XX,Y
  1.  S:'$D(SVENIEN) SVENIEN=""
  1.  ;
  1.  ; First create and array of all current IPAC Vendor Agreement data to display
  1.  S CNT=0,VAIEN=0
  1.  F  D  Q:+VAIEN=0
  1.  . S VAIEN=$O(^FBAA(161.95,VAIEN))
  1.  . Q:+VAIEN=0
  1.  . S VENIEN=$P(^FBAA(161.95,VAIEN,0),U,2)                       ; Vendor IEN
  1.  . Q:(SVENIEN'="")&(SVENIEN'=VENIEN)                            ; Not the selected Vendor
  1.  . S CNT=CNT+1
  1.  . S XX=$$LJ^XLFSTR(CNT,3)                                      ; Selection #
  1.  . S XX=XX_$$LJ^XLFSTR($P(^FBAA(161.95,VAIEN,0),U,1),11)        ; ID
  1.  . S XX=XX_$$LJ^XLFSTR($P(^FBAA(161.95,VAIEN,0),U,3),5)         ; Fiscal Year
  1.  . S XX=XX_$$LJ^XLFSTR($$GET1^DIQ(161.2,VENIEN_",",.01),"29T")  ; Vendor Name
  1.  . S XX=XX_"  "
  1.  . S XX=XX_$P(^FBAA(161.95,VAIEN,0),U,4)_" "                    ; Status
  1.  . S XX=XX_$$LJ^XLFSTR($P(^FBAA(161.95,VAIEN,0),U,5),"26T")     ; Description
  1.  . S VADATA(CNT)=VAIEN_U_XX
  1.  ;
  1.  I 'CNT D  Q OUT
  1.  . S OUT=""
  1.  . Q:STEXT=""
  1.  . W !!,"No IPAC Agreements are currently on file."
  1.  . H:'NEW 1
  1.  . Q:'NEW
  1.  . S DIR("A")="Enter a new agreement"
  1.  . S DIR(0)="Y"
  1.  . D ^DIR
  1.  . S:+Y=1 OUT=0
  1.  ;
  1.  ; Next display all of the current IPAC Vendor Agreements
  1.  S DIR(0)="FO",LN=0
  1.  S:NEW DIR("B")="NEW"
  1.  S LN=LN+1,DIR("A",LN)=FLINE
  1.  S LN=LN+1,DIR("A",LN)=" "
  1.  S LN=LN+1,DIR("A",LN)="#  ID         FY   Vendor                         S Description"
  1.  S LN=LN+1,DIR("A",LN)="-- ---------- ---- ------------------------------ - -------------------------"
  1.  S IX=""
  1.  F  D  Q:IX=""
  1.  . S IX=$O(VADATA(IX))
  1.  . Q:IX=""
  1.  . S LN=LN+1,DIR("A",LN)=$P(VADATA(IX),U,2)
  1.  I STEXT="" D  Q ""                                             ; Just display, no selection
  1.  . W !!
  1.  . S LN=""
  1.  . F  D  Q:LN=""
  1.  . . S LN=$O(DIR("A",LN))
  1.  . . Q:LN=""
  1.  . . W !,DIR("A",LN)
  1.  S LN=LN+1,DIR("A",LN)=" "
  1.  S LN=LN+1,DIR("A",LN)=STEXT
  1.  S DIR("A")="Selection #"
  1. SELVA1 ; Looping tag
  1.  W !!
  1.  K X,Y
  1.  D ^DIR
  1.  I $D(DTOUT)!$D(DUOUT) Q ""                                     ; User timed out or pressed ^
  1.  S XX=$$UP^XLFSTR(Y)
  1.  I NEW Q:(XX="NEW")!(XX="N")!(XX="NE")!(XX="") 0                ; Creating a new one
  1.  I 'NEW Q:XX="" ""                                              ; User quitting
  1.  I XX>0,XX'>CNT,XX?.N Q $P(VADATA(XX),U,1)                      ; Selected IEN
  1.  ;
  1.  W !!,*7,"Enter a number from 1-"_CNT
  1.  W:NEW " or Type 'NEW'"
  1.  H 1
  1.  G SELVA1
  1.  ;
  1. SELMRA(FLINE,STEXT,STATUS,ACTION) ;EP
  1.  ; Displays all of the currently filed MRA records with a status of 'T' and
  1.  ; allows the user to select one
  1.  ; Input:   FLINE       - Text of the first line to be displayed
  1.  ;          STEXT       - User Selection prompt to be displayed
  1.  ;          STATUS      - 'P'   - Display pending MRA Records
  1.  ;                        'T'   - Display transmitted MRA records
  1.  ;                        ''    - Display both pending and transmitted records
  1.  ;          ACTION      - 'A'   - Display Add MRA records
  1.  ;                        'C'   - Display Change MRA records
  1.  ;                        'D'   - Display Deleted MRA records
  1.  ;                        ''    - Display MRA records with any type of action
  1.  ; Output:  MRA Records that match the specified criteria are displayed to the screen.
  1.  ;          If there are none, a message is displayed
  1.  ; Returns: MRAIEN      - IEN of the selected MRA Record
  1.  ;                        "" - No MRA record was selected
  1.  N CNT,LN,DIR,DIROUT,DIRUT,DTOUT,DUOUT,IX,MRAACT,MRADATA,MRAIEN,MRASTAT
  1.  N OUT,TDT,VAIEN,VENIEN,X,XX,Y,ZZ
  1.  ;
  1.  ; First create and array of all current MRA records that match the selection criteria
  1.  S CNT=0,MRAIEN=0
  1.  F  D  Q:+MRAIEN=0
  1.  . S MRAIEN=$O(^FBAA(161.96,MRAIEN))
  1.  . Q:+MRAIEN=0
  1.  . S ZZ=^FBAA(161.96,MRAIEN,0)
  1.  . S MRAACT=$P(ZZ,U,4)                                          ; Action of the MRA Record
  1.  . S MRASTAT=$P(ZZ,U,5)                                         ; Status of the MRA Record
  1.  . I STATUS'="",STATUS'=MRASTAT Q                               ; Not the specified status
  1.  . I ACTION'="",ACTION'=MRAACT Q                                ; Not the specified action
  1.  . S CNT=CNT+1
  1.  . S XX=$$LJ^XLFSTR(CNT,3)                                      ; Selection #
  1.  . S XX=XX_$$LJ^XLFSTR($P(ZZ,U,3),11)                           ; IPAC Agreement ID
  1.  . S XX=XX_$$LJ^XLFSTR(MRASTAT,2)                               ; Status
  1.  . S XX=XX_$$LJ^XLFSTR(MRAACT,2)                                ; Action
  1.  . I (STATUS="")!(STATUS="T") D                                 ; Transmit Date
  1.  . . S TDT=$P(ZZ,U,6)
  1.  . . S:TDT'="" TDT=$$FMTE^XLFDT(TDT,2)                          ; Converted to external
  1.  . . S XX=XX_$$LJ^XLFSTR(TDT,9)
  1.  . ;
  1.  . ; Only displaying MRA records with an action of DELETE - no more columns to display
  1.  . I ACTION="D" S MRADATA(CNT)=MRAIEN_U_XX Q
  1.  . S VAIEN=$P(ZZ,U,2)                                           ; IPAC Agreement IEN
  1.  . S VENIEN=$P($G(^FBAA(161.95,VAIEN,0)),U,2)                   ; Vendor IEN
  1.  . S XX=XX_$$LJ^XLFSTR($$GET1^DIQ(161.2,VENIEN_",",.01),"30T")_" "  ; Vendor Name
  1.  . S XX=XX_$$LJ^XLFSTR($P(^FBAA(161.95,VAIEN,0),U,5),"23T")     ; Description
  1.  . S MRADATA(CNT)=MRAIEN_U_XX
  1.  ;
  1.  I 'CNT D  Q OUT
  1.  . S OUT=""
  1.  . Q:STEXT=""
  1.  . W !!,"No MRA records that match the specified criteria are currently on file."
  1.  ;
  1.  ; Next display all of the found MRA Records
  1.  S DIR(0)="FO",LN=0
  1.  S LN=LN+1,DIR("A",LN)=FLINE
  1.  S LN=LN+1,DIR("A",LN)=" "
  1.  S LN=LN+1,DIR("A",LN)="#  ID         A "
  1.  I (STATUS="")!(STATUS="T") D
  1.  . S DIR("A",LN)=DIR("A",LN)_"S Trans Dt "
  1.  I (ACTION'="D") D
  1.  . S DIR("A",LN)=DIR("A",LN)_"Vendor                         Description"
  1.  S LN=LN+1,DIR("A",LN)="-- ---------- - "
  1.  I (STATUS="")!(STATUS="T") D
  1.  . S DIR("A",LN)=DIR("A",LN)_"- -------- "
  1.  I (ACTION'="D") D
  1.  . S DIR("A",LN)=DIR("A",LN)_"------------------------------ ----------------------"
  1.  S IX=""
  1.  F  D  Q:IX=""
  1.  . S IX=$O(MRADATA(IX))
  1.  . Q:IX=""
  1.  . S LN=LN+1,DIR("A",LN)=$P(MRADATA(IX),U,2)
  1.  S LN=LN+1,DIR("A",LN)=" "
  1.  S LN=LN+1,DIR("A",LN)=STEXT
  1.  S DIR("A")="Selection #"
  1. SELMRA1 ; Looping tag
  1.  W !!
  1.  K X,Y
  1.  D ^DIR
  1.  I $D(DTOUT)!$D(DUOUT) Q ""                                     ; User timed out or pressed ^
  1.  S XX=$$UP^XLFSTR(Y)
  1.  Q:XX="" ""                                                     ; User quitting
  1.  I XX>0,XX'>CNT,XX?.N Q $P(MRADATA(XX),U,1)                     ; Selected IEN
  1.  ;
  1.  W !!,*7,"Enter a number from 1-"_CNT
  1.  H 1
  1.  G SELMRA1
  1.  ;
  1. VADISP(VAIEN,TOSCREEN,VAOUT)   ;EP
  1.  ; Returns the IPAC Vendor Agreement Display Layout for a specified vendor 
  1.  ; agreement
  1.  ; Input:   VAIEN   - Vendor Agreement IEN to build display layout for
  1.  ;          TOSCREEN    - 1 - Display the Vendor Agreement to the screen, don't return VAOUT
  1.  ;                        0 - Don't display it, return array VAOUT instead
  1.  ; Output:  VAOUT       - Array of IPAC Vendor Agreement Display Layout lines
  1.  ;                        Only returned if TOSCREEN=0
  1.  ;
  1.  N LN,VADATA,XX
  1.  K VAOUT
  1.  ; Invalid Vendor Agreement
  1.  Q:'$D(^FBAA(161.95,VAIEN))
  1.  ;
  1.  D VALOAD(VAIEN,.VADATA)
  1.  S XX=VADATA("ID"),VAOUT(1)="IPAC Vendor Agreement ID: "_$$LJ^XLFSTR(XX,12)
  1.  S XX=VADATA("STAT"),VAOUT(1)=VAOUT(1)_"Status: "_$$LJ^XLFSTR(XX,10)
  1.  S XX=VADATA("FY"),VAOUT(1)=VAOUT(1)_"FY: "_$$LJ^XLFSTR(XX,1,6)
  1.  S XX=VADATA("VENDOR"),VAOUT(2)="Vendor: "_$$LJ^XLFSTR(XX,48)
  1.  S XX=VADATA("DESC"),VAOUT(3)="  Desc: "_$$LJ^XLFSTR(XX,62)
  1.  S XX=VADATA("SHAN"),VAOUT(4)="     Sharing Agreement #: "_$$LJ^XLFSTR(XX,"15T")
  1.  S XX=VADATA("CALC"),VAOUT(5)="Customer ALC: "_$$LJ^XLFSTR(XX,10)
  1.  S XX=VADATA("RTAS"),VAOUT(5)=VAOUT(5)_"Receiver TAS: "_$$LJ^XLFSTR(XX,"29T")
  1.  S XX=VADATA("STAS"),VAOUT(6)=$$LJ^XLFSTR("",24," ")_"  Sender TAS: "_$$LJ^XLFSTR(XX,"29T")
  1.  S XX=VADATA("ASN"),VAOUT(7)="Agency Field Station #: "_$$LJ^XLFSTR(XX,"10T")
  1.  S XX=VADATA("OB"),VAOUT(7)=VAOUT(7)_"Obligating Document #: "_$$LJ^XLFSTR(XX,"19T")
  1.  S VAOUT(8)="Station Contact: "
  1.  S XX=VADATA("CON"),VAOUT(9)="    Name: "_$$LJ^XLFSTR(XX,62)
  1.  S XX=VADATA("CONPHN"),VAOUT(10)="   Phone: "_$$LJ^XLFSTR(XX,"17T")
  1.  S XX=VADATA("CONEM"),VAOUT(10)=VAOUT(10)_" Email: "_$$LJ^XLFSTR(XX,"40T") ; 1st 40 chars or email
  1.  S VAOUT(11)=$S($L(XX)'>40:"",1:"   "_$E(XX,41,$L(XX)))         ; Remaining chars of email
  1.  S VAOUT(12)="Complete Line of Accounting: "
  1.  S XX=VADATA("LOA"),VAOUT(13)="   "_$$LJ^XLFSTR(XX,62)
  1.  S VAOUT(14)="Description of Goods & Services: "
  1.  S XX=VADATA("GOOD"),VAOUT(15)="   "_$$LJ^XLFSTR(XX,"70T")
  1.  S VAOUT(16)=$S($L(XX)'>70:"",1:"   "_$E(XX,71,140))            ; Next 70 chars
  1.  S VAOUT(17)=$S($L(XX)'>140:"",1:"   "_$E(XX,141,$L(XX)))       ; Remaining chars
  1.  S VAOUT(18)="Miscellaneous Info: "
  1.  S XX=VADATA("MISC1"),VAOUT(19)="1) "_$$LJ^XLFSTR(XX,"75T")
  1.  S VAOUT(20)=$S($L(XX)'>75:"",1:"   "_$E(XX,76,150))            ; Next 75 chars
  1.  S VAOUT(21)=$S($L(XX)'>150:"",1:"   "_$E(XX,151,$L(XX)))       ; Remaining chars
  1.  S XX=VADATA("MISC2"),VAOUT(22)="2) "_$$LJ^XLFSTR(XX,"75T")
  1.  S VAOUT(23)=$S($L(XX)'>75:"",1:"   "_$E(XX,76,$L(XX)))         ; Remaining chars
  1.  Q:'TOSCREEN
  1.  ;
  1.  S LN=""
  1.  F  D  Q:LN=""
  1.  . S LN=$O(VAOUT(LN))
  1.  . Q:LN=""
  1.  . I VAOUT(LN)="***" W ! Q
  1.  . W:$TR(VAOUT(LN)," ","")'="" !,VAOUT(LN)
  1.  K VAOUT
  1.  Q
  1.  ;
  1. VALOAD(VAIEN,VADATA) ;EP
  1.  ; Returns an array of external field values for a specified Vendor Agreement
  1.  ; Input:   VAIEN           - Vendor Agreement IEN
  1.  ; Output:  VADATA("ASN")   - Agency Field Station Number
  1.  ;          VADATA("CALC")  - Customer ALC
  1.  ;          VADATA("CON")   - Station Contact Name
  1.  ;          VADATA("CONEM") - Station Contact Email
  1.  ;          VADATA("CONPHN")- Station Contact Phone
  1.  ;          VADATA("DESC")  - Vendor Agreement Description
  1.  ;          VADATA("FY")    - Fiscal Year
  1.  ;          VADATA("GOOD")  - Description of Goods and Services
  1.  ;          VADATA("ID")    - Vendor Agreement ID
  1.  ;          VADATA("LOA")   - Complete line of Accounting
  1.  ;          VADATA("OB")    - Obligating document number
  1.  ;          VADATA("MISC1") - Miscellaneous Info 1
  1.  ;          VADATA("MISC2") - Miscellaneous Info 2
  1.  ;          VADATA("RTAS")  - Receiver TAS
  1.  ;          VADATA("SHAN")  - Sharing Agreement Number
  1.  ;          VADATA("STAS")  - Sender TAS
  1.  ;          VADATA("STAT")  - Vendor Agreement Status
  1.  ;          VADATA("VENDOR")- External Vendor name
  1.  ;         
  1.  ;
  1.  N IPAC
  1.  D GETS^DIQ(161.95,VAIEN_",","**","E","IPAC")
  1.  S VADATA("ID")=IPAC(161.95,VAIEN_",",".01","E")
  1.  ;
  1.  S VADATA("VENDOR")=IPAC(161.95,VAIEN_",",1,"E")
  1.  S VADATA("FY")=IPAC(161.95,VAIEN_",",2,"E")
  1.  S VADATA("STAT")=IPAC(161.95,VAIEN_",",3,"E")
  1.  S VADATA("DESC")=IPAC(161.95,VAIEN_",",4,"E")
  1.  S VADATA("SHAN")=IPAC(161.95,VAIEN_",",5,"E")
  1.  S VADATA("CALC")=IPAC(161.95,VAIEN_",",6,"E")
  1.  S VADATA("RTAS")=IPAC(161.95,VAIEN_",",7,"E")
  1.  S VADATA("STAS")=IPAC(161.95,VAIEN_",",7.5,"E")
  1.  S VADATA("ASN")=IPAC(161.95,VAIEN_",",8,"E")
  1.  S VADATA("OB")=IPAC(161.95,VAIEN_",",9,"E")
  1.  S VADATA("CON")=IPAC(161.95,VAIEN_",",10,"E")
  1.  S VADATA("CONPHN")=IPAC(161.95,VAIEN_",",11,"E")
  1.  S VADATA("CONEM")=IPAC(161.95,VAIEN_",",12,"E")
  1.  S VADATA("LOA")=IPAC(161.95,VAIEN_",",13,"E")
  1.  S VADATA("GOOD")=IPAC(161.95,VAIEN_",",14,"E")
  1.  S VADATA("MISC1")=IPAC(161.95,VAIEN_",",15,"E")
  1.  S VADATA("MISC2")=IPAC(161.95,VAIEN_",",16,"E")
  1.  Q
  1.  ;
  1. LOCKVA(VAIEN,DMSG) ;EP
  1.  ; Attempt to lock IPAC Vendor Agreement
  1.  ; Input:   VAIEN    - IPAC Vendor Agreement to be locked
  1.  ;          DMSG     - 1 - Display locked message
  1.  ;                     0 - Don't display locked message
  1.  ;                     Optional, defaults to 1
  1.  ; Returns: 1 - IPAC Vendor Agreement locked, 0 otherwise
  1.  ;
  1.  S:'$D(DMSG) DMSG=1
  1.  L +^FBAA(161.95,VAIEN):0
  1.  I '$T D  Q 0
  1.  . W:DMSG !!,"Somebody is already editing this agreement.  Try again later."
  1.  . H 1
  1.  Q 1
  1.  ;
  1. UNLOCKVA(VAIEN)    ;EP
  1.  ; Unlock the IPAC Vendor Agreement
  1.  ; Input:   VAIEN    - Vendor Agreement to be locked
  1.  ; Output:  IPAC Vendor Agreement is unlocked
  1.  L -^FBAA(161.95,VAIEN)
  1.  Q
  1.  ;