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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAAVD3 1558 printed Dec 13, 2024@01:57:05 Page 2
FBAAVD3 ;WCIOFO/SAB-EDIT VENDOR FPDS DATA ;10/6/97
+1 ;;3.5;FEE BASIS;**9,10**;JAN 30, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
RDV ; ask vendor
+1 DO GETVEN^FBAAUTL1
if IFN=""
GOTO EXIT
SET DA=IFN
+2 ; display vendor
+3 ;D EN1^FBAAVD
+4 ; check vendor
+5 IF $DATA(^FBAA(161.25,"AF",DA))
Begin DoDot:1
+6 ; linked vendor
+7 WRITE !,"Current vendor information is pending Austin processing."
+8 WRITE !,"Use the Display/Edit Vendor option if changes need to be made."
End DoDot:1
GOTO RDV
+9 IF $DATA(^FBAA(161.25,DA,0))
IF $PIECE(^(0),U,5)]""
Begin DoDot:1
+10 ; awaiting reply from Austin
+11 WRITE !,"Current vendor information is pending Austin processing."
+12 WRITE !,"Use the Display/Edit Vendor option if changes need to be made."
End DoDot:1
GOTO RDV
+13 IF $PIECE($GET(^FBAAV(DA,"ADEL")),U)="Y"
Begin DoDot:1
+14 WRITE !,"Vendor has been deleted."
+15 WRITE !,"Use the Display/Edit Vendor option if changes need to be made."
End DoDot:1
GOTO RDV
+16 ; lock vendor
+17 LOCK +^FBAAV(DA):5
IF '$TEST
Begin DoDot:1
+18 WRITE !,"Vendor is being accessed by another user."
+19 WRITE !,"Please try again later."
End DoDot:1
GOTO RDV
+20 ; save current FPDS data
+21 SET FBBT("O")=$PIECE($GET(^FBAAV(DA,1)),U,10)
+22 DO GETGRP^FBAAUTL6(DA)
+23 ; edit vendor FPDS data
+24 SET DIE="^FBAAV("
SET DR="24;S FBBT=X;25;S:$$VGRP^FBAAUTL6(D0) Y=24"
+25 DO ^DIE
KILL DIE
+26 ; if data changed store in 161.25
+27 IF $PIECE($GET(^FBAAV(DA,1)),U,10)'=FBBT("O")!$$GRPDIF^FBAAUTL6(DA)
Begin DoDot:1
+28 ; already queued, all actions inc. FPDS data
if $DATA(^FBAA(161.25,DA,0))
QUIT
+29 ; add to file 161.25 with action of F
+30 SET FBT="F"
SET FBIEN1=DA
SET FEEO=""
DO SETGL^FBAAVD
+31 KILL FBT,FBIEN1,FEEO
End DoDot:1
+32 ; unlock vendor
+33 LOCK -^FBAAV(DA)
+34 ;
+35 GOTO RDV
EXIT ;
+1 KILL DA,DIE,DR,IFN,FBBT,FBSG
+2 QUIT
