FBVDISP.m

FBVDISP ;AISC/CMR-VENDOR DISPLAY IDENTIFIERS - APR 9, 1993

 ;;3.5;FEE BASIS;;JAN 30, 1995

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

 N FBT,FBVC,FBZ S FBT(0)=$G(^FBAAV(Y,0)) Q:FBT(0)']""  F FBT=2,3,4,5,6,9,10,14 S FBT(FBT)=$P(FBT(0),U,FBT)

 S FBT(99)=$P($G(^FBAAV(Y,1)),U),FBT(98)=$P($G(^FBAAV(Y,"ADEL")),U)

 W:FBT(2)]"" ?40,FBT(2)

 W:FBT(10) "  CHAIN #: ",FBT(10)

 W:FBT(9)]"" "  ",$E($P($G(^FBAA(161.81,+FBT(9),0)),U),1,15)

 W:FBT(3)]"" !?10,FBT(3) D

 .S FBZ=$$CKVEN^FBAADV(+Y) I FBZ W:FBT(3)']"" ! W ?40,"(Awaiting Austin Approval)"

 .I FBT(98)="Y" W:FBT(3)']""!(FBZ) ! W ?40,"(Vendor in Delete Status)"

 W:FBT(14)]"" !?10,FBT(14)

 W:FBT(4)]"" !?10,FBT(4)

 W:FBT(5)]"" ", ",$P($G(^DIC(5,+FBT(5),0)),U,2)

 W:FBT(6)]"" "  ",FBT(6)

 W:FBT(99)]"" "    TEL. #:  ",FBT(99)

 W !?1

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---FBVDISP   820     printed  Apr 09, 2024@21:02:45                                                                                                                                                                                                      Page 2

FBVDISP   ;AISC/CMR-VENDOR DISPLAY IDENTIFIERS - APR 9, 1993

 +1       ;;3.5;FEE BASIS;;JAN 30, 1995

 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.

 +3        NEW FBT,FBVC,FBZ

           SET FBT(0)=$GET(^FBAAV(Y,0))

           if FBT(0)']""

               QUIT 

           FOR FBT=2,3,4,5,6,9,10,14

               SET FBT(FBT)=$PIECE(FBT(0),U,FBT)

 +4        SET FBT(99)=$PIECE($GET(^FBAAV(Y,1)),U)

           SET FBT(98)=$PIECE($GET(^FBAAV(Y,"ADEL")),U)

 +5        if FBT(2)]""

               WRITE ?40,FBT(2)

 +6        if FBT(10)

               WRITE "  CHAIN #: ",FBT(10)

 +7        if FBT(9)]""

               WRITE "  ",$EXTRACT($PIECE($GET(^FBAA(161.81,+FBT(9),0)),U),1,15)

 +8        if FBT(3)]""

               WRITE !?10,FBT(3)

           Begin DoDot:1

 +9            SET FBZ=$$CKVEN^FBAADV(+Y)

               IF FBZ

                   if FBT(3)']""

                       WRITE !

                   WRITE ?40,"(Awaiting Austin Approval)"

 +10           IF FBT(98)="Y"

                   if FBT(3)']""!(FBZ)

                       WRITE !

                   WRITE ?40,"(Vendor in Delete Status)"

           End DoDot:1

 +11       if FBT(14)]""

               WRITE !?10,FBT(14)

 +12       if FBT(4)]""

               WRITE !?10,FBT(4)

 +13       if FBT(5)]""

               WRITE ", ",$PIECE($GET(^DIC(5,+FBT(5),0)),U,2)

 +14       if FBT(6)]""

               WRITE "  ",FBT(6)

 +15       if FBT(99)]""

               WRITE "    TEL. #:  ",FBT(99)

 +16       WRITE !?1