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

FBAAIAE.m

Go to the documentation of this file. 
  1. 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
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ;-----------------------------------------------------------------------------
  1.  ;                           Entry Points
  1.  ; ADDEDIT  - Add/Edit an IPAC Vendor Agreement
  1.  ;            NOTE: (actually called from first line of routine)
  1.  ;-----------------------------------------------------------------------------
  1.  ;
  1. ADDEDIT ;EP
  1.  ; Add/Edit an IPAC Vendor Agreement
  1.  ; Called From: Menu - FBAA IPAC AGREEMENT Add/Edit an IPAC agreement
  1.  N XX
  1.  F  S XX=$$ADDEDIT1() Q:XX=1
  1.  Q
  1.  ;
  1. ADDEDIT1()  ; Used to loop
  1.  ; Input:       None
  1.  ; Returns:     1 - User timed out or typed '^' to exit, 0 otherwise
  1.  ; Called From: ADDEDT
  1.  N IX,FLINE,MODE,STEXT,VAEDITED,VAIEN,VASTAT,VASTATO
  1.  S FLINE="The following IPAC Agreements are currently on file:"
  1.  S STEXT="Please select the IPAC agreement to edit or type NEW to create a new entry"
  1.  S MODE=$$SELVA^FBAAIAU(FLINE,STEXT,1,"")       ; Select an IPAC Agreement
  1.  I MODE="" Q 1                                  ; User exit
  1.  I MODE=0 D ADDVA Q 0                           ; Add a new IPAC Agreement
  1.  S VAIEN=MODE,MODE=1                            ; Edit IPAC agreement
  1.  ;
  1.  ; Attempt to lock the IPAC Vendor Agreement file
  1.  Q:'$$LOCKVA^FBAAIAU(VAIEN) 0                   ; Attempt to lock the Vendor Agreement
  1.  ;
  1.  ; Warn the user if the selected agreement is incomplete
  1.  S VASTATO=$P(^FBAA(161.95,VAIEN,0),U,4)        ; Current Agreement status
  1.  I VASTATO="N" D                                ; Incomplete Vendor Agreement warning
  1.  . W !!,"This IPAC Vendor Agreement is not complete. Complete it using this option"
  1.  . W !,"or use the IPAC Vendor Agreement delete option to delete it."
  1.  ;
  1.  ; Store current Vendor agreement field values
  1.  K ^TMP($J,"FBAAIAC")
  1.  F IX=0:1:6 S ^TMP($J,"FBAAIAC",IX)=$G(^FBAA(161.95,VAIEN,IX))
  1.  D EDITVA1(VAIEN)                               ; Edit the IPAC Agreement
  1.  S VASTAT=$P(^FBAA(161.95,VAIEN,0),U,4)         ; Current Agreement status
  1.  ;
  1.  ; IPAC Agreement is still incomplete - unlock it and quit
  1.  I VASTAT="N" D  Q 0
  1.  . D UNLOCKVA^FBAAIAU(VAIEN)                    ; Unlock the Vendor Agreement
  1.  . K ^TMP($J,"FBAAIAC")
  1.  ;
  1.  ; Check if the status went from N to A - First time agreement is complete
  1.  I VASTATO="N",VASTAT="A" D  Q 0                ; Send ADD MRA
  1.  . D A^FBAAIAQ(VAIEN)                           ; Create an ADD MRA record
  1.  . D UNLOCKVA^FBAAIAU(VAIEN)                    ; Unlock the Vendor Agreement
  1.  . K ^TMP($J,"FBAAIAC")
  1.  ;
  1.  ; Check to see if any of the field values were changed 
  1.  S VAEDITED=0
  1.  F IX=0:1:6 D  Q:VAEDITED
  1.  . I $G(^FBAA(161.95,VAIEN,IX))'=$G(^TMP($J,"FBAAIAC",IX)) S VAEDITED=1
  1.  ;
  1.  ; Agreement was edited, create a MRA record for the changes
  1.  D:VAEDITED=1 C^FBAAIAQ(VAIEN)                  ; Send Change MRA
  1.  D UNLOCKVA^FBAAIAU(VAIEN)                      ; Unlock the Vendor Agreement
  1.  K ^TMP($J,"FBAAIAC")
  1.  Q 0
  1.  ;
  1. ADDVA ;
  1.  ; Add a new IPAC Vendor Agreement
  1.  ; Called From: ADDEDIT
  1.  N FYR,VAIEN,VASTAT,VENIEN,XX
  1.  S VENIEN=$$VENDSEL()                           ; Select a Vendor
  1.  Q:VENIEN=""                                    ; No Vendor selected
  1.  ;
  1.  ; Display any active or new agreements for the selected vendor
  1.  Q:'$$DISPVA(VENIEN)
  1.  S FYR=$$FYR()                                  ; Ask fiscal year via DIR
  1.  ;
  1.  ; Add an IPAC Vendor Agreement for the selected vendor
  1.  Q:'$$ADDVA1(VENIEN,FYR,.VAIEN)
  1.  S VASTAT=$P(^FBAA(161.95,VAIEN,0),U,4)         ; Current Agreement status
  1.  D:VASTAT'="N" A^FBAAIAQ(VAIEN)                 ; Create an ADD MRA record
  1.  Q
  1.  ;
  1. VENDSEL()   ; Selects a Vendor to add an agreement for
  1.  ; Input:       None
  1.  ; Output:      None
  1.  ; Returns:     VENIEN          - IEN of the selected Vendor or "" if not selected
  1.  ; Called From: ADDVA
  1.  N DA,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,QUIT,VENIEN,X,Y
  1.  S DIC="^FBAAV(",DIC(0)="AEQM"
  1.  S DIC("A")="Select a Vendor: "
  1.  S DIC("S")="I $P($G(^(""AMS"")),""^"",4)=""F"""    ; Only Show Federal Vendors
  1.  D ^DIC
  1.  I Y'>0 Q ""                                        ; No selected Vendor
  1.  S VENIEN=+Y,QUIT=0
  1.  I $P($G(^FBAAV(VENIEN,"ADEL")),U,1)="Y" D          ; Deleted Vendor
  1.  . S DIR(0)="Y"
  1.  . W !!,"This vendor has been deleted from the Austin vendor database"
  1.  . S DIR("A")="Do you wish to continue",DIR("B")="No"
  1.  . D ^DIR
  1.  . S:Y'>0 QUIT=1
  1.  Q:QUIT ""
  1.  Q VENIEN
  1.  ;
  1. FYR() ; Prompt the user for the Fiscal year of the agreement
  1.  ; Input:       None
  1.  ; Output:      None
  1.  ; Returns:     FYR     - IEN of the selected Vendor or "" if not selected
  1.  ; Called From: ADDVA
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,XX,Y,FBCURR,FBMON,FBYR
  1.  S DIR(0)="161.95,2"
  1.  S FBCURR=$$FMTE^XLFDT(DT,"7D")    ; current date
  1.  S FBMON=$P(FBCURR,"/",2)          ; current month
  1.  S FBYR=$P(FBCURR,"/",1)           ; current year
  1.  I FBMON'<10 S FBYR=FBYR+1         ; for Oct-Dec, Fiscal year is Calendar year+1
  1.  S DIR("B")=FBYR
  1.  D ^DIR
  1.  Q Y
  1.  ;
  1. DISPVA(VENIEN) ; Display any active or new agreements on file for this vendor
  1.  ; Input:       VENIEN      - Selected Vendor IEN
  1.  ; Output:      New/Active agreements for vendor are displayed
  1.  ; Returns:     Selected Vendor or "" if no vendor was de-selected
  1.  ; Called From: ADDVA
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,FLINE,VAIEN,VASTAT,X,Y
  1.  ;
  1.  ; Selected Vendor doesn't have any new or active agreements
  1.  I '$D(^FBAA(161.95,"AVA",VENIEN,"A")),'$D(^FBAA(161.95,"AVA",VENIEN,"N")) Q VENIEN
  1.  S FLINE="This vendor has the following active IPAC agreement(s) on file:"
  1.  D SELVA^FBAAIAU(FLINE,"",0,VENIEN)
  1.  W !
  1.  S DIR(0)="Y",DIR("A")="Do you wish to continue with this vendor",DIR("B")="No"
  1.  D ^DIR
  1.  Q:Y'>0 ""                                      ; De-select the vendor
  1.  Q VENIEN
  1.  ;
  1. ADDVA1(VENIEN,FYR,VAIEN) ; Add a new IPAC Vendor agreement for the selected vendor
  1.  ; Input:       VENIEN      - Selected Vendor IEN
  1.  ;              FYR         - Fiscal Year of the new IPAC agreement
  1.  ; Output:      VAIEN       - IEN of the added/edited Vendor agreement
  1.  ;              Vendor agreement is filed for the selected vendor
  1.  ; Returns:     0 if New entry couldn't be added 1 otherwise
  1.  ; Called From: ADDVA
  1.  N DA,DIC,DIE,DO,DR,DTOUT,VAID,X,Y
  1.  Q:'$$LOCKVA 0                                  ; Lock IPAC Agreement file
  1.  S VAID=$$NEXTVAID()                            ; Last IPAC ID number
  1.  D UNLOCKVA                                     ; Unlock Vendor Agreement file            
  1.  ;
  1.  ; Add a new entry to the IPAC Vendor Agreement file with Identity fields only
  1.  ; NOTE: if not all the identity fields are added, no agreement is filed
  1.  S X=VAID,DIC=161.95
  1.  S DIC(0)="Z",DIC("DR")="1////^S X=VENIEN;2///^S X=FYR;3////N"
  1.  D FILE^DICN
  1.  I (+Y'>0)!($P(Y,U,3)'=1) D  Q 0
  1.  . W !!," A new IPAC Agreement cannot be filed at this time."
  1.  S VAIEN=+Y
  1.  S DIE=161.95,DA=VAIEN
  1.  S DR="4:16"
  1.  D ^DIE
  1.  D CHKREQ^FBAAIAU(VAIEN)                        ; Check the status
  1.  Q 1
  1.  ;
  1. NEXTVAID()  ; Increments the last IPAC ID number in the parameter file
  1.  ; and returns the new value
  1.  ; Input:       None
  1.  ; Output:      Sets the Last IPAC ID number parameter
  1.  ; Returns:     Next Available IPAC ID number
  1.  N DA,DR,DIE,DTOUT,VAID
  1.  I '$D(^FBAA(161.4,1,"IPAC"))!'$D(^FBAA(161.95)) S VAID=100
  1.  E  S VAID=^FBAA(161.4,1,"IPAC")
  1.  ;
  1.  ; Make sure this is truly the last number and if not, find the last one
  1.  S:$D(^FBAA(161.95,"B",VAID)) VAID=$O(^FBAA(161.95,"B",""),-1)
  1.  S VAID=VAID+1                                  ; Get the new 'LAST' ID
  1.  S DIE=161.4,DA=1,DR="80///^S X=VAID"
  1.  D ^DIE                                         ; File the new last number
  1.  Q VAID
  1.  ; 
  1. EDITVA1(VAIEN) ; Edit the selected IPAC Vendor agreement
  1.  ; Input:       VAIEN       - IEN of the IPAC Vendor agreement to edit
  1.  ; Called From: ADDVA
  1.  N DA,DIE,DR,DTOUT,INV,VASTAT
  1.  S DIE=161.95,DA=VAIEN
  1.  S VASTAT=$P(^FBAA(161.95,VAIEN,0),U,4),INV=0
  1.  ;
  1.  ; Check for current invoices for the selected agreement
  1.  S:$D(^FBAAC("IPAC",VAIEN))!($D(^FBAA(162.1,"IPAC",VAIEN))!($D(^FBAAI("IPAC",VAIEN)))) INV=1
  1.  ;
  1.  ; Display Vendor and Fiscal Year but don't allow edit if invoices exist
  1.  I INV D
  1.  . N FYR,VENDOR
  1.  . S VENDOR=$P(^FBAA(161.95,VAIEN,0),"^",2)
  1.  . S VENDOR=$E($P(^FBAAV(VENDOR,0),"^",1),1,36)
  1.  . S FYR=$P(^FBAA(161.95,VAIEN,0),"^",3)
  1.  . W !!,"The IPAC Agreement you have selected has been used on one or more payment "
  1.  . W !,"records.  Because of this the Vendor and the Fiscal Year are not editable."
  1.  . W !!,"     VENDOR: ",$$LJ^XLFSTR(VENDOR,38),"(No editing allowed)"
  1.  . W !,"FISCAL YEAR: ",$$LJ^XLFSTR(FYR,38),"(No editing allowed)",!
  1.  S DR=$S('INV:"1:2;",1:"")
  1.  S DR=DR_$S(VASTAT'="N":"3:16",1:"4:16")
  1.  D ^DIE
  1.  D CHKREQ^FBAAIAU(VAIEN)                        ; Check the status
  1.  Q
  1.  ;
  1. LOCKVA() ; Attempt to lock the Vendor agreement file to add a new agreement
  1.  ; Input:   None
  1.  ; Output:  Vendor agreement file locked or error message displayed
  1.  ; Returns: 1 - Vendor agreement file locked, 0 otherwise
  1.  L +^FBAA(161.95,0):0
  1.  I '$T D  Q 0
  1.  . W !!,"Someone is editing the IPAC Agreement file.  Cannot enter a new IPAC agreement"
  1.  . W !,"file at this time.  Try again at a later time."
  1.  Q 1
  1.  ;
  1. UNLOCKVA() ; Unlock Vendor agreement file
  1.  ; Input:   None
  1.  ; Output:  Vendor agreement file unlocked
  1.  L -^FBAA(161.95,0)
  1.  Q
  1.  ;