FBAADV.m

FBAADV ;AISC/GRR-FLAG VENDOR FOR DELETION IN CENTRAL FEE ; 8/28/09 12:35pm

 ;;3.5;FEE BASIS;**111**;JAN 30, 1995;Build 17

 ;;Per VHA Directive 2004-038, this routine should not be modified.

 D DT^DICRW

RD W !! S DIC(0)="AEQM",DIC="^FBAAV(" D ^DIC G END:X="^"!(X=""),RD:Y<0 S DA=+Y I $$CKVEN(DA) W !!?5,*7,"Unable to delete, vendor is Awaiting Austin Approval." G RD

ASK S DIR(0)="Y",DIR("A")="Are you sure you want to place this vendor in delete status",DIR("B")="NO" D ^DIR K DIR G:$D(DIRUT) END W !! I 'Y W *7,"Not Deleted" G RD

 S DIE="^FBAAV(",DR="9////Y;13////^S X=DT" D LOCK^FBUCUTL(DIE,DA) I FBLOCK D ^DIE L -^FBAAV(DA) K DIE W !!,*7,"Vendor flagged for deletion!" G RD

 W !!,*7,"Unable to delete vendor record at this time." G RD

END K FBZ,X,DIC,DIRUT,Y,DA,FBLOCK Q

CKVEN(FBVIEN) ;Checks to see if a change or add is pending in the Fee Basis Vendor Corrections file (#161.25)

 ;fbvien = internal entry # of vendor from Fee Basis Vendor file (#161.2)

 ;output: 1 = change or add awaiting austin approval, 0 = nothing pending, 2 = change or add on linked vendor awaiting austin approval

 N FBVC S FBVC=$P($G(^FBAA(161.25,FBVIEN,0)),U,2,3),FBVC=$TR(FBVC,U) Q $S(FBVC["C":1,FBVC["N":1,$D(^FBAA(161.25,+FBVIEN,0))!($D(^FBAA(161.25,"AF",+FBVIEN))):2,1:0)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---FBAADV   1270     printed  Apr 09, 2024@21:07:17                                                                                                                                                                                                      Page 2

FBAADV    ;AISC/GRR-FLAG VENDOR FOR DELETION IN CENTRAL FEE ; 8/28/09 12:35pm

 +1       ;;3.5;FEE BASIS;**111**;JAN 30, 1995;Build 17

 +2       ;;Per VHA Directive 2004-038, this routine should not be modified.

 +3        DO DT^DICRW

RD         WRITE !!

           SET DIC(0)="AEQM"

           SET DIC="^FBAAV("

           DO ^DIC

           if X="^"!(X="")

               GOTO END

           if Y<0

               GOTO RD

           SET DA=+Y

           IF $$CKVEN(DA)

               WRITE !!?5,*7,"Unable to delete, vendor is Awaiting Austin Approval."

               GOTO RD

ASK        SET DIR(0)="Y"

           SET DIR("A")="Are you sure you want to place this vendor in delete status"

           SET DIR("B")="NO"

           DO ^DIR

           KILL DIR

           if $DATA(DIRUT)

               GOTO END

           WRITE !!

           IF 'Y

               WRITE *7,"Not Deleted"

               GOTO RD

 +1        SET DIE="^FBAAV("

           SET DR="9////Y;13////^S X=DT"

           DO LOCK^FBUCUTL(DIE,DA)

           IF FBLOCK

               DO ^DIE

               LOCK -^FBAAV(DA)

               KILL DIE

               WRITE !!,*7,"Vendor flagged for deletion!"

               GOTO RD

 +2        WRITE !!,*7,"Unable to delete vendor record at this time."

           GOTO RD

END        KILL FBZ,X,DIC,DIRUT,Y,DA,FBLOCK

           QUIT 

CKVEN(FBVIEN) ;Checks to see if a change or add is pending in the Fee Basis Vendor Corrections file (#161.25)

 +1       ;fbvien = internal entry # of vendor from Fee Basis Vendor file (#161.2)

 +2       ;output: 1 = change or add awaiting austin approval, 0 = nothing pending, 2 = change or add on linked vendor awaiting austin approval

 +3        NEW FBVC

           SET FBVC=$PIECE($GET(^FBAA(161.25,FBVIEN,0)),U,2,3)

           SET FBVC=$TRANSLATE(FBVC,U)

           QUIT $SELECT(FBVC["C":1,FBVC["N":1,$DATA(^FBAA(161.25,+FBVIEN,0))!($DATA(^FBAA(161.25,"AF",+FBVIEN))):2,1:0)