FBCHDEL.m

FBCHDEL ;AISC/DMK - DELETE NOTIFICATION/REQUEST ;7/11/14  15:39

 ;;3.5;FEE BASIS;**154**;JAN 30, 1995;Build 12

 ;;Per VA Directive 6402, this routine should not be modified.

 D HOME^%ZIS S DIC("S")=$S($D(^XUSEC("FBAA LEVEL 2",DUZ)):"I $P(^(0),U,17)=""""",1:"I $P(^(0),U,17)=""""&($P(^(0),U,8)=DUZ)") D ASKV^FBCHREQ G END:X=""!(X="^")

 W !! S DR="0:99" D EN^DIQ

ASK S DIR(0)="Y",DIR("A")="Are you sure you want to delete this Request",DIR("B")="NO" D ^DIR K DIR G END:$D(DIRUT)!'Y

EN I $D(DA),DA S FBDA=DA,DIK="^FBAA(162.2," D ^DIK W !,?3,"...request deleted",!

 I $D(FBDA),FBDA,$D(^FBAA(161.5,FBDA,0)) S DA=FBDA,DIK="^FBAA(161.5," D ^DIK

END K DIC,DIK,DIRUT,DA,FBDA,X,VAL,FBDA,DR,FBDFN,FBNAME,FBSSN,S,Y Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---FBCHDEL   714     printed  Apr 09, 2024@21:00:56                                                                                                                                                                                                      Page 2

FBCHDEL   ;AISC/DMK - DELETE NOTIFICATION/REQUEST ;7/11/14  15:39

 +1       ;;3.5;FEE BASIS;**154**;JAN 30, 1995;Build 12

 +2       ;;Per VA Directive 6402, this routine should not be modified.

 +3        DO HOME^%ZIS

           SET DIC("S")=$SELECT($DATA(^XUSEC("FBAA LEVEL 2",DUZ)):"I $P(^(0),U,17)=""""",1:"I $P(^(0),U,17)=""""&($P(^(0),U,8)=DUZ)")

           DO ASKV^FBCHREQ

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

               GOTO END

 +4        WRITE !!

           SET DR="0:99"

           DO EN^DIQ

ASK        SET DIR(0)="Y"

           SET DIR("A")="Are you sure you want to delete this Request"

           SET DIR("B")="NO"

           DO ^DIR

           KILL DIR

           if $DATA(DIRUT)!'Y

               GOTO END

EN         IF $DATA(DA)

               IF DA

                   SET FBDA=DA

                   SET DIK="^FBAA(162.2,"

                   DO ^DIK

                   WRITE !,?3,"...request deleted",!

 +1        IF $DATA(FBDA)

               IF FBDA

                   IF $DATA(^FBAA(161.5,FBDA,0))

                       SET DA=FBDA

                       SET DIK="^FBAA(161.5,"

                       DO ^DIK

END        KILL DIC,DIK,DIRUT,DA,FBDA,X,VAL,FBDA,DR,FBDFN,FBNAME,FBSSN,S,Y

           QUIT