BMCDLRR.m

BMCDLRR ; IHS/PHXAO/TMJ - delete routine referral definition ;

 ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006

 ;

 ;

 W !!,"This option allows the user to delete a routine referral definition.",!,"This should only be done if the routine referral is no longer valid.",!!

 S DIC="^BMCRTNRF(",DIC(0)="AEMQ" D ^DIC

 I Y=-1 W !!,"NO DEFINTION SELECTED." G XIT

 S BMCRR=+Y

 S DIR(0)="Y",DIR("A")="Are you sure you want to delete the "_$P(^BMCRTNRF(BMCRR,0),U)_" referral definition",DIR("B")="N" K DA D ^DIR K DIR

 G:$D(DIRUT) XIT

 G:'Y XIT

 W !!,"DELETING ",$P(^BMCRTNRF(BMCRR,0),U)

 S DA=BMCRR,DIK="^BMCRTNRF(" D ^DIK K DA,DIK

XIT ;

 K BMCRR

 K DIR

 D ^XBFMK

 Q

BMCDLRR   ; IHS/PHXAO/TMJ - delete routine referral definition ;

 +1       ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006

 +2       ;

 +3       ;

 +4        WRITE !!,"This option allows the user to delete a routine referral definition.",!,"This should only be done if the routine referral is no longer valid.",!!

 +5        SET DIC="^BMCRTNRF("

           SET DIC(0)="AEMQ"

           DO ^DIC

 +6        IF Y=-1

               WRITE !!,"NO DEFINTION SELECTED."

               GOTO XIT

 +7        SET BMCRR=+Y

 +8        SET DIR(0)="Y"

           SET DIR("A")="Are you sure you want to delete the "_$PIECE(^BMCRTNRF(BMCRR,0),U)_" referral definition"

           SET DIR("B")="N"

           KILL DA

           DO ^DIR

           KILL DIR

 +9        IF $DATA(DIRUT)

               GOTO XIT

 +10       IF 'Y

               GOTO XIT

 +11       WRITE !!,"DELETING ",$PIECE(^BMCRTNRF(BMCRR,0),U)

 +12       SET DA=BMCRR

           SET DIK="^BMCRTNRF("

           DO ^DIK

           KILL DA,DIK

XIT       ;

 +1        KILL BMCRR

 +2        KILL DIR

 +3        DO ^XBFMK

 +4        QUIT