- 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 Feb 18, 2025@23:23:31 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
