- 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 ---[H[J[2J[HFBAADV 1270 printed Feb 18, 2025@23:21:46 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)