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/XPDMENU.m@ 1766

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

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1XPDMENU ;SFISC/RWF,RSD - Manage Menu items ;07/03/2003 09:12
2 ;;8.0;KERNEL;**21,302**;Jul 10, 1995
3 Q
4 ;
5 ;MENU=option to add to, OPT=option to add to MENU, SYN=synonym
6 ;ORD=display order
7ADD(MENU,OPT,SYN,ORD) ;EF. Add options to a menu or extended action
8 Q:$G(MENU)']"" 0 Q:$G(OPT)']"" 0
9 N X,XPD1,XPD2,XPD3,DIC,DA,D0,DR,DLAYGO
10 S XPD1=$$LKOPT(MENU) Q:XPD1'>0 "0^no menu"
11 ;quit if type is not menu or extended action
12 I "MX"'[$E($$TYPE(XPD1)_"~",1) Q "0^wrong type"
13 S XPD2=$$LKOPT(OPT) Q:XPD2'>0 "0^option not found"
14 ;if OPTion is not in menu, add it
15 I '$D(^DIC(19,XPD1,10,"B",XPD2)) D
16 .S X=XPD2,(D0,DA(1))=XPD1,DIC(0)="MLF",DIC("P")=$P(^DD(19,10,0),"^",2),DLAYGO=19,DIC="^DIC(19,"_XPD1_",10,"
17 .D FILE^DICN
18 S XPD3=$O(^DIC(19,XPD1,10,"B",XPD2,0))
19 I XPD3>0 S DR="" S:$G(SYN)]"" DR="2///"_SYN_";" S:$G(ORD)]"" DR=DR_"3///"_ORD I DR]"" S DIE="^DIC(19,"_XPD1_",10,",DA=XPD3,DA(1)=XPD1 D ^DIE
20 Q XPD3>0
21 ;
22LKOPT(X) ;EF. To lookup on "B"
23 Q $O(^DIC(19,"B",X,0))
24 ;
25TYPE(X) ;EF. Return option type, Pass IFN.
26 Q:X'>0 "" Q $P($G(^DIC(19,X,0)),"^",4)
27 ;
28 ;MENU=option to delete from, OPT=option to delete
29DELETE(MENU,OPT) ;EF. Delete item from menu or extended action.
30 Q:$G(MENU)']"" 0 Q:$G(OPT)']"" 0
31 N XPD1,XPD2,DIK,DA,X
32 S XPD1=$$LKOPT(MENU) Q:XPD1'>0 0
33 I "MX"'[$E($$TYPE(XPD1)_"~",1) Q 0
34 S XPD2=$$LKOPT(OPT) Q:XPD2'>0 0
35 S DA=$O(^DIC(19,XPD1,10,"B",XPD2,0)) Q:DA'>0 0
36 S DA(1)=XPD1,DIK="^DIC(19,XPD1,10," D ^DIK
37 Q 1
38 ;
39 ;OPT=option to set out of order, TXT=message
40OUT(OPT,TXT) ;Set option out of order
41 Q:$G(OPT)']""
42 N XPD,XPD1
43 S XPD1=$$LKOPT(OPT) Q:XPD1'>0
44 S XPD(19,XPD1_",",2)=$G(TXT) D FILE^DIE("","XPD")
45 Q
46 ;
47 ;OLD=old name, NEW=new name
48RENAME(OLD,NEW) ;Rename option
49 Q:$G(OLD)']"" Q:$G(NEW)']""
50 N XPD,XPD1
51 S XPD1=$$LKOPT(OLD) Q:XPD1'>0
52 S XPD(19,XPD1_",",.01)=NEW D FILE^DIE("","XPD")
53 Q
Note: See TracBrowser for help on using the repository browser.