43 lines
1.5 KiB
Mathematica
43 lines
1.5 KiB
Mathematica
|
FBAAVD3 ;WCIOFO/SAB-EDIT VENDOR FPDS DATA ;10/6/97
|
||
|
|
;;3.5;FEE BASIS;**9,10**;JAN 30, 1995
|
||
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
||
|
|
RDV ; ask vendor
|
||
|
|
D GETVEN^FBAAUTL1 G:IFN="" EXIT S DA=IFN
|
||
|
|
; display vendor
|
||
|
|
;D EN1^FBAAVD
|
||
|
|
; check vendor
|
||
|
|
I $D(^FBAA(161.25,"AF",DA)) D G RDV
|
||
|
|
. ; linked vendor
|
||
|
|
. W !,"Current vendor information is pending Austin processing."
|
||
|
|
. W !,"Use the Display/Edit Vendor option if changes need to be made."
|
||
|
|
I $D(^FBAA(161.25,DA,0)),$P(^(0),U,5)]"" D G RDV
|
||
|
|
. ; awaiting reply from Austin
|
||
|
|
. W !,"Current vendor information is pending Austin processing."
|
||
|
|
. W !,"Use the Display/Edit Vendor option if changes need to be made."
|
||
|
|
I $P($G(^FBAAV(DA,"ADEL")),U)="Y" D G RDV
|
||
|
|
. W !,"Vendor has been deleted."
|
||
|
|
. W !,"Use the Display/Edit Vendor option if changes need to be made."
|
||
|
|
; lock vendor
|
||
|
|
L +^FBAAV(DA):5 I '$T D G RDV
|
||
|
|
. W !,"Vendor is being accessed by another user."
|
||
|
|
. W !,"Please try again later."
|
||
|
|
; save current FPDS data
|
||
|
|
S FBBT("O")=$P($G(^FBAAV(DA,1)),U,10)
|
||
|
|
D GETGRP^FBAAUTL6(DA)
|
||
|
|
; edit vendor FPDS data
|
||
|
|
S DIE="^FBAAV(",DR="24;S FBBT=X;25;S:$$VGRP^FBAAUTL6(D0) Y=24"
|
||
|
|
D ^DIE K DIE
|
||
|
|
; if data changed store in 161.25
|
||
|
|
I $P($G(^FBAAV(DA,1)),U,10)'=FBBT("O")!$$GRPDIF^FBAAUTL6(DA) D
|
||
|
|
. Q:$D(^FBAA(161.25,DA,0)) ; already queued, all actions inc. FPDS data
|
||
|
|
. ; add to file 161.25 with action of F
|
||
|
|
. S FBT="F",FBIEN1=DA,FEEO="" D SETGL^FBAAVD
|
||
|
|
. K FBT,FBIEN1,FEEO
|
||
|
|
; unlock vendor
|
||
|
|
L -^FBAAV(DA)
|
||
|
|
;
|
||
|
|
G RDV
|
||
|
|
EXIT ;
|
||
|
|
K DA,DIE,DR,IFN,FBBT,FBSG
|
||
|
|
Q
|