source: FOIAVistA/tag/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XQ11.m@ 1796

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

initial load of FOIAVistA 6/30/08 version

File size: 2.9 KB
Line 
1XQ11 ;SEA/MJM - Menu Utilities ;1/08/2006
2 ;;8.0;KERNEL;**155,372**;Jul 10, 1995;Build 3
3 ;
4COPY ;Make a copy of a menu-type option
5 S XQA=$S(DUZ(0)["@":1,$D(^XUSEC("XUMGR",DUZ)):1,$D(^XUSEC("XUPROGMODE",DUZ)):1,1:0)
6 S XQD="",%=0 I $D(^VA(200,DUZ,19.6,0)),$L($P(^(0),U,3)),$P(^(0),U,3)>0 F XQI=0:0 S %=$O(^VA(200,DUZ,19.6,%)) Q:%=""!(%'?1N.N) S XQD=XQD_^(%,0)_","
7 I 'XQA,'$L(XQD) W !!,"Sorry. You need to be assigned a valid name space to proceed." H 6 S XQH="XQNAMSPAC" D EN^XQH Q
8 ;
9 S DIC="^DIC(19,",DIC(0)="AEMQZ",DIC("A")="Menu you would like to make a copy of: " D ^DIC
10 Q:Y=-1 S XQYO=+Y
11 W !!,"WARNING ** Option names must be carefully named to avoid system damage!!",!?5,"Do you want more information? Yes// "
12 R XQUR:DTIME S:"Nn"'[$E(XQUR,1) XQUR="Y" I "Yy"[$E(XQUR,1) S XQH="XQNAMSPAC" D EN^XQH
13ASK W !!,"What is the new menu's name: " R XQUR:DTIME S:'$T XQUR=U G:XQUR[U OUT
14 S XQF=1 I 'XQA S XQF=0 F XQI=1:1 S %=$P(XQD,",",XQI) Q:%="" I %=$E(XQUR,1,$L(%)) S XQF=1 Q
15 I 'XQF W !!?5,"Sorry. Your new option must begin with: " F XQI=1:1 S %=$P(XQD,",",XQI) Q:%="" W $S(XQI=1:"",1:" or "),%
16 I 'XQF G ASK
17 ;
18 S (XQF,XQF0,XQF1)=0 I $D(^DIC(19,"B",XQUR)) S XQYN=$O(^(XQUR,0)) W !!?5,"Sorry, this option name is already in use." S XQF=1
19 I XQF,$P(^DIC(19,XQYN,0),U,5)=DUZ S XQF0=1
20REP I XQF,XQF0 W !!?5,"Do you want to replace it? No// " R %:DTIME S:'$T %=U G:%=U OUT S:%="" %="N" G:"Nn"[$E(%) ASK S:"Yy"[$E(%) XQF1=1 I %["?" W !!?5,"If you answer 'Y' the existing option will be replaced by the one you're creating." G REP
21 I XQF,'XQF1 G ASK
22 I $L(XQUR)>30!(+XQUR=XQUR)!($L(XQUR)<3)!'(XQUR'?1P.E)!(XQUR'?.UNP) W *7,!!?5,"3 to 30 uppercase characters, please." G ASK
23 ;
24TXT ;Get the new menu text
25 W !!,"The old menu text is ","""",$P(^DIC(19,+XQYO,0),U,2),"""",!
26 K DIR S DIR("?")="Please enter 10 to 50 characters describing what the new option does.",DIR(0)="19,1",DIR("A")="What will option say?"
27 D ^DIR S XQUR0=X G:$D(DIRUT) OUT
28 ;R XQUR0:DTIME S:'$T XQUR0=U G:XQUR0[U OUT G:'$L(XQUR0) TXT I $E(XQUR0,1)="?"!($L(XQUR0)<10)!($L(XQUR0)>50)!(XQUR0'?. W !!?5,"Please enter 10 to 50 characters describing what the new option does." G TXT
29 S XQUP=$$UP^XLFSTR(XQUR0) ;F XQI=1:1 Q:XQUP?.NUP S %=$A(XQUP,XQI) I %<123,%>96 S XQUP=$E(XQUP,1,XQI-1)_$C(%-32)_$E(XQUP,XQI+1,255)
30 ;
31FIL ;Get FileMan to put this all in.
32 S DIR("?")="'Y' means create the new menu. 'N' means don't.",DIR(0)="YA",DIR("A")="Is everything OK? ",DIR("B")="No" D ^DIR G:$D(DIRUT) OUT I Y=0 D OUT G ^XQ11
33 I 'XQF S DIC(0)="LMXZ",X=XQUR,DLAYGO=19 D FILE^DICN S XQYN=Y
34 S %X="^DIC(19,"_+XQYO_",",%Y="^DIC(19,"_+XQYN_"," D %XY^%RCR
35 ;S $P(^DIC(19,+XQYN,0),U)=XQUR S DIK="^DIC(19,",DA=+XQYN D IX^DIC
36 S DIE="^DIC(19,",DR=".01///"_XQUR_";1///"_XQUR0_";3.6////"_DUZ_";",DA=+XQYN D ^DIE S ^DIC(19,+XQYN,"U")=$E(XQUP,1,30)
37 ;
38OUT K %,%1,%X,%Y,C,D,D0,DA,DDH,DI,DIC,DIE,DIG,DIH,DIK,DIR,DIU,DIV,DIW,DLAYGO,DQ,DR,X,XQA,XQD,XQF,XQF0,XQF1,XQH,XQI,XQUP,XQUR,XQUR0,XQYN,XQYO,Y
39 Q
Note: See TracBrowser for help on using the repository browser.