source: FOIAVistA/trunk/r/REMOTE_ORDER_ENTRY_SYSTEM-RMPF-RMPJ/RMPFEU.m@ 1607

Last change on this file since 1607 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.9 KB
Line 
1RMPFEU ;DDC/KAW-AUDIOLOGIST APPROVAL PRIVILEGES; [ 06/16/95 3:06 PM ]
2 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
3RMPFSET I '$D(RMPFMENU) D MENU^RMPFUTL I '$D(RMPFMENU) W !!,$C(7),"*** A MENU SELECTION MUST BE MADE ***" Q ;;RMPFMENU must be defined
4 I '$D(RMPFSTAN)!'$D(RMPFDAT)!'$D(RMPFSYS) D ^RMPFUTL Q:'$D(RMPFSTAN)!'$D(RMPFDAT)!'$D(RMPFSYS)
5 W @IOF,!!,"AUDIOLOGIST APPROVAL PRIVILEGES"
6A1 W ! S DIC=200,DIC(0)="AEQM",DIC("A")="Select User: "
7 D ^DIC G END:Y=-1 S RMPFUR=+Y,RMPFURP=$P(Y,U,2)
8 G A2:'$D(^RMPF(791813,RMPFSTAN,101,RMPFUR,0)),A2:'$P(^(0),U,3)
9 W !!,RMPFURP," already has Audiologist approval privileges."
10SUP W !!,"Do you wish to delete the privileges? NO// "
11 D READ G END:$D(RMPFOUT)
12SUP1 I $D(RMPFQUT) W !!,"If a <Y>es is entered, Audiologist approval privileges will be deleted.",!,"If <N>o or <RETURN> is entered, privileges will be retained." G SUP
13 S:Y="" Y="N" I "YyNn"'[Y S RMPFQUT="" G SUP1
14 G A1:"Nn"[Y S DIE="^RMPF(791813,"_RMPFSTAN_",101,"
15 S DA=RMPFUR,DA(1)=RMPFSTAN,DR=".03////0;.04////" D ^DIE
16 W !!,"*** AUDIOLOGIST APPROVAL PRIVILEGES DELETED ***" G A1
17A2 W !!,"Add Audiologist approval privileges for ",RMPFURP,"? NO// "
18 D READ G END:$D(RMPFOUT)
19A21 I $D(RMPFQUT) W !!,"Enter <Y> to give this user Audiologist approval privileges",!?6,"<N> or <RETURN> to continue." G A2
20 S:Y="" Y="N" I "YyNn"'[Y S RMPFQUT="" G A21
21 G A1:"Nn"[Y
22 S:'$D(^RMPF(791813,RMPFSTAN,101,0)) ^RMPF(791813,RMPFSTAN,101,0)="^791813.0101P^^"
23 I '$D(^RMPF(791813,RMPFSTAN,101,RMPFUR,0)) S ^RMPF(791813,RMPFSTAN,101,RMPFUR,0)=RMPFUR,^RMPF(791813,RMPFSTAN,101,"B",RMPFUR,RMPFUR)=""
24 S $P(^RMPF(791813,RMPFSTAN,101,RMPFUR,0),U,3)=1
25 W !!,"*** AUDIOLOGIST APPROVAL PRIVILEGES ADDED ***" G A1
26END K RMPFAUD,RMPFUR,RMPFURP,RMPFOUT,RMPFQUT,DLAYGO,DIC
27 K DISYS,X,Y,DA,DR,DIE,DQ,D0,DI Q
28READ K RMPFOUT,RMPFQUT
29 R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
30 I Y?1"^".E S (RMPFOUT,Y)="" Q
31 S:Y?1"?".E (RMPFQUT,Y)=""
32 Q
Note: See TracBrowser for help on using the repository browser.