source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XQSMD4.m@ 975

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

initial load of WorldVistAEHR

File size: 2.8 KB
RevLine 
[613]1XQSMD4 ; SEA/MJM,JLI - Edit a user's options ;2/1/90 15:32 ;
2 ;;8.0;KERNEL;;Jul 10, 1995
3BUILD ;
4 I '($D(^VA(200,DUZ,19.5,0))#2) W !!,$C(7),"You have not been delegated options with which to build a menu.",! G K
5 D NAME I 'XQVALID G K
6 W !!,"OPTION NAME: " R X:$S($D(DTIME):DTIME,1:999) G:'$T!(X="")!(X[U) K D CHKNAM G:'XQVALID BUILD
7 S XQSMDOPT=X,DIC(0)="MLE",DIC=19,DLAYGO=19 D ^DIC G:Y'>0 BUILD S XQSMDY=+Y I '$P(Y,U,3) G OLD
8 ;
9NEW ;
10 S DIE=DIC,DR="1;3.5;4///M;",DA=+Y D ^DIE ; ENTER AS NEW OPTION AND FORCE TYPE TO BE MENU
11 S DIC="^VA(200,"_DUZ_",19.5,",P=200.19,X=XQSMDOPT,DIC(0)="MLX",DA(1)=DUZ,DLAYGO=200 D ^DIC Q:Y'>0
12 G EDIT
13 ;
14OLD ;
15 I $P(^DIC(19,XQSMDY,0),U,4)'="M" W !,*7,"This option already exists but is not a MENU." G BUILD
16 I '$D(^VA(200,DUZ,19.5,XQSMDY,0)) W !,*7,"This option already exists but is not included in your delegated options,",!,"choose another option name or get this option delegated to yourself" G BUILD
17 ;
18EDIT ;
19 W !!,"NOTE THAT YOU MAY ONLY INCLUDE OPTIONS THAT HAVE BEEN DELEGATED AS ITEMS TO",!,"YOU.",!
20 ;
21EDIT1 ;
22 W !," Select ITEM: " R X:$S($D(DTIME):DTIME,1:999) G:'$T!(X="")!(X[U) ENDIT
23 S DIC("S")="I $D(^VA(200,DUZ,19.5,+Y,0)) Q",DIC="^DIC(19,",P=19,DIC(0)="EQM" D ^DIC I Y'>0 G EDIT1
24 K DIC S DLAYG0=19,X=$P(Y,U,2),DIC="^DIC(19,XQSMDY,10,",P=19.01,DA(1)=XQSMDY,D0=XQSMDY,DIC(0)="ML" S:'$D(@(DIC_"0)")) @(DIC_"0)")="^19.01PI" D ^DIC I Y'>0 G ENDIT
25 I '$P(Y,U,3) S DR=".01///@;" W !,*7,"MENU ITEM ",$P(^DIC(19,+$P(Y,U,2),0),U,1)," DELETED FROM MENU ******" ; IF RESELECTED REMOVE IT FROM MENU
26 E S DR="2:3;"
27 S DIE=DIC,DA=+Y,DA(1)=XQSMDY D ^DIE
28 G EDIT1
29 ;
30NAME ; Check for available namespaces, let user know rules
31 I '$D(^VA(200,DUZ,19.6)) W !!,*7,"No available namespace(s) has been established for you to build new menus.",!,"See your site manager or his representative to establish your namespace(s).",!!,*7 S XQVALID=0 Q
32 K X S X=0 F I=0:0 S I=$O(^VA(200,DUZ,19.6,I)) Q:I'>0 S X=X+1,X(X)=^(I,0)
33 I X=0 K ^VA(200,DUZ,19.6) G NAME
34 W !,"The menu options you build or edit must begin with ",$S(X>1:"one of ",1:""),"the namespace",$S(X>1:"(s)",1:""),":"
35 F I=1:1:X W !?10,X(I)_"Z"
36 W ! S XQVALID=1
37 Q
38 ;
39CHKNAM ;
40 S XQVALID=0 F I=0:0 S I=$O(X(I)) Q:I="" I $E(X,1,$L(X(I)))=X(I),$E(X,$L(X(I))+1)="Z" S XQVALID=1 Q
41 I 'XQVALID W !!,*7,"A menu option created by user from delegated options is a local option and MUST",!,"begin with a valid namespace, e.g., ",X(1),", followed by the letter Z, e.g., ",X(1),"Zxxx.",*7,!
42 Q
43ENDIT ;
44 S XQVALID=$O(^DIC(19,XQSMDY,10,0)),DIE="^VA(200,"_DUZ_",19.5,"
45 I XQVALID'>0 S DA(1)=DUZ,DA=XQSMDY,P=200.19,DR=".01///@;" D ^DIE S DIE=19,DA=XQSMDY,DR=".01///@;" D ^DIE W !!,*7,"** EMPTY MENU removed from option file and your delegated options",*7,!
46K K XQSMDUZ,XQSMDY,XQSMDOPT,XQVALID,DIE,DIC,%,%1,%DT,%H,%W,%Y,D,D0,D1,DA,DI,DIG,DIH,DIU,DIV,DQ,DR,I,J,K,L,P,X,XQD,XQPK,XQR,DG,DIW,XY,Y,DICR
47 Q
Note: See TracBrowser for help on using the repository browser.