ASDOVB.m

ASDOVB ; IHS/ADC/PDW/ENM - ENTER OVERBOOK USERS ; [ 03/25/1999  11:48 AM ]

 ;;5.0;IHS SCHEDULING;;MAR 25, 1999

 ;

CLN ;

 W !! K DIC,DIE S DIC=44,DIC(0)="AEMQ",DIC("A")="Select CLINIC:  "

 S DIC("S")="I $P(^(0),U,3)=""C"",$D(^(""SL""))"

 D ^DIC G END:X=""!(X=U),CLN:Y<1

 L +^SC(+Y):3 I '$T W !,*7,"CLINIC ENTRY LOCKED; TRY AGAIN SOON" G END

 S DIE=44,DA=+Y,DR="[ASD OVERBOOK USER]" D ^DIE L -^SC(DA)

 G CLN

 ;

END ; -- eoj

 K DIC,DIE,DA,DR,X,Y Q

ASDOVB    ; IHS/ADC/PDW/ENM - ENTER OVERBOOK USERS ; [ 03/25/1999  11:48 AM ]

 +1       ;;5.0;IHS SCHEDULING;;MAR 25, 1999

 +2       ;

CLN       ;

 +1        WRITE !!

           KILL DIC,DIE

           SET DIC=44

           SET DIC(0)="AEMQ"

           SET DIC("A")="Select CLINIC:  "

 +2        SET DIC("S")="I $P(^(0),U,3)=""C"",$D(^(""SL""))"

 +3        DO ^DIC

           IF X=""!(X=U)

               GOTO END

           IF Y<1

               GOTO CLN

 +4        LOCK +^SC(+Y):3

           IF '$TEST

               WRITE !,*7,"CLINIC ENTRY LOCKED; TRY AGAIN SOON"

               GOTO END

 +5        SET DIE=44

           SET DA=+Y

           SET DR="[ASD OVERBOOK USER]"

           DO ^DIE

           LOCK -^SC(DA)

 +6        GOTO CLN

 +7       ;

END       ; -- eoj

 +1        KILL DIC,DIE,DA,DR,X,Y

           QUIT