XPDMENU ;SFISC/RWF,RSD - Manage Menu items ;11/02/2005 689530.624382
;;8.0;KERNEL;**21,302,672**;Jul 10, 1995;Build 28
;;Per VA Directive 6402, this routine should not be modified.
Q
;
;MENU=option to add to, OPT=option to add to MENU, SYN=synonym
;ORD=display order
ADD(MENU,OPT,SYN,ORD) ;EF. Add options to a menu or extended action
Q:$G(MENU)']"" 0 Q:$G(OPT)']"" 0
N X,XPD1,XPD2,XPD3,DIC,DA,D0,DR,DLAYGO
S XPD1=$$LKOPT(MENU) Q:XPD1'>0 "0^no menu"
;quit if type is not Broker, Menu or Extended action
I "BMX"'[$E($$TYPE(XPD1)_"~",1) Q "0^wrong type"
S XPD2=$$LKOPT(OPT) Q:XPD2'>0 "0^option not found"
;if OPTion is not in menu, add it
I '$D(^DIC(19,XPD1,10,"B",XPD2)) D
.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,"
.D FILE^DICN
S XPD3=$O(^DIC(19,XPD1,10,"B",XPD2,0))
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
Q XPD3>0
;
LKOPT(X) ;EF. To lookup on "B"
Q $O(^DIC(19,"B",X,0))
;
TYPE(X) ;EF. Return option type, Pass IFN.
Q:X'>0 "" Q $P($G(^DIC(19,X,0)),"^",4)
;
;MENU=option to delete from, OPT=option to delete
DELETE(MENU,OPT) ;EF. Delete item from menu or extended action.
Q:$G(MENU)']"" 0 Q:$G(OPT)']"" 0
N XPD1,XPD2,DIK,DA,X
S XPD1=$$LKOPT(MENU) Q:XPD1'>0 0
I "MX"'[$E($$TYPE(XPD1)_"~",1) Q 0
S XPD2=$$LKOPT(OPT) Q:XPD2'>0 0
S DA=$O(^DIC(19,XPD1,10,"B",XPD2,0)) Q:DA'>0 0
S DA(1)=XPD1,DIK="^DIC(19,XPD1,10," D ^DIK
Q 1
;
;OPT=option to set out of order, TXT=message
OUT(OPT,TXT) ;Set option out of order
Q:$G(OPT)']""
N XPD,XPD1
S XPD1=$$LKOPT(OPT) Q:XPD1'>0
S XPD(19,XPD1_",",2)=$G(TXT) D FILE^DIE("","XPD")
Q
;
;OLD=old name, NEW=new name
RENAME(OLD,NEW) ;Rename option
Q:$G(OLD)']"" Q:$G(NEW)']""
N XPD,XPD1
S XPD1=$$LKOPT(OLD) Q:XPD1'>0
S XPD(19,XPD1_",",.01)=NEW D FILE^DIE("","XPD")
Q
;
;OPT=option name, TXT=Security Key, file 19.1
LOCK(OPT,TXT) ;Set option LOCK
Q:$G(OPT)']""
N XPD,XPD1
S XPD1=$$LKOPT(OPT) Q:XPD1'>0
S XPD(19,XPD1_",",3)=$G(TXT) D FILE^DIE("E","XPD")
Q
;
;OPT=option name, TXT=Security Key, file 19.1
RLOCK(OPT,TXT) ;Set option Reverse Lock
Q:$G(OPT)']""
N XPD,XPD1
S XPD1=$$LKOPT(OPT) Q:XPD1'>0
S XPD(19,XPD1_",",3.01)=$G(TXT) D FILE^DIE("E","XPD")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXPDMENU 2381 printed Dec 13, 2024@02:04:23 Page 2
+1 ;;8.0;KERNEL;**21,302,672**;Jul 10, 1995;Build 28
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;MENU=option to add to, OPT=option to add to MENU, SYN=synonym
+6 ;ORD=display order
ADD(MENU,OPT,SYN,ORD) ;EF. Add options to a menu or extended action
+1 if $GET(MENU)']""
QUIT 0
if $GET(OPT)']""
QUIT 0
+2 NEW X,XPD1,XPD2,XPD3,DIC,DA,D0,DR,DLAYGO
+3 SET XPD1=$$LKOPT(MENU)
if XPD1'>0
QUIT "0^no menu"
+4 ;quit if type is not Broker, Menu or Extended action
+5 IF "BMX"'[$EXTRACT($$TYPE(XPD1)_"~",1)
QUIT "0^wrong type"
+6 SET XPD2=$$LKOPT(OPT)
if XPD2'>0
QUIT "0^option not found"
+7 ;if OPTion is not in menu, add it
+8 IF '$DATA(^DIC(19,XPD1,10,"B",XPD2))
Begin DoDot:1
+9 SET X=XPD2
SET (D0,DA(1))=XPD1
SET DIC(0)="MLF"
SET DIC("P")=$PIECE(^DD(19,10,0),"^",2)
SET DLAYGO=19
SET DIC="^DIC(19,"_XPD1_",10,"
+10 DO FILE^DICN
End DoDot:1
+11 SET XPD3=$ORDER(^DIC(19,XPD1,10,"B",XPD2,0))
+12 IF XPD3>0
SET DR=""
if $GET(SYN)]""
SET DR="2///"_SYN_";"
if $GET(ORD)]""
SET DR=DR_"3///"_ORD
IF DR]""
SET DIE="^DIC(19,"_XPD1_",10,"
SET DA=XPD3
SET DA(1)=XPD1
DO ^DIE
+13 QUIT XPD3>0
+14 ;
LKOPT(X) ;EF. To lookup on "B"
+1 QUIT $ORDER(^DIC(19,"B",X,0))
+2 ;
TYPE(X) ;EF. Return option type, Pass IFN.
+1 if X'>0
QUIT ""
QUIT $PIECE($GET(^DIC(19,X,0)),"^",4)
+2 ;
+3 ;MENU=option to delete from, OPT=option to delete
DELETE(MENU,OPT) ;EF. Delete item from menu or extended action.
+1 if $GET(MENU)']""
QUIT 0
if $GET(OPT)']""
QUIT 0
+2 NEW XPD1,XPD2,DIK,DA,X
+3 SET XPD1=$$LKOPT(MENU)
if XPD1'>0
QUIT 0
+4 IF "MX"'[$EXTRACT($$TYPE(XPD1)_"~",1)
QUIT 0
+5 SET XPD2=$$LKOPT(OPT)
if XPD2'>0
QUIT 0
+6 SET DA=$ORDER(^DIC(19,XPD1,10,"B",XPD2,0))
if DA'>0
QUIT 0
+7 SET DA(1)=XPD1
SET DIK="^DIC(19,XPD1,10,"
DO ^DIK
+8 QUIT 1
+9 ;
+10 ;OPT=option to set out of order, TXT=message
OUT(OPT,TXT) ;Set option out of order
+1 if $GET(OPT)']""
QUIT
+2 NEW XPD,XPD1
+3 SET XPD1=$$LKOPT(OPT)
if XPD1'>0
QUIT
+4 SET XPD(19,XPD1_",",2)=$GET(TXT)
DO FILE^DIE("","XPD")
+5 QUIT
+6 ;
+7 ;OLD=old name, NEW=new name
RENAME(OLD,NEW) ;Rename option
+1 if $GET(OLD)']""
QUIT
if $GET(NEW)']""
QUIT
+2 NEW XPD,XPD1
+3 SET XPD1=$$LKOPT(OLD)
if XPD1'>0
QUIT
+4 SET XPD(19,XPD1_",",.01)=NEW
DO FILE^DIE("","XPD")
+5 QUIT
+6 ;
+7 ;OPT=option name, TXT=Security Key, file 19.1
LOCK(OPT,TXT) ;Set option LOCK
+1 if $GET(OPT)']""
QUIT
+2 NEW XPD,XPD1
+3 SET XPD1=$$LKOPT(OPT)
if XPD1'>0
QUIT
+4 SET XPD(19,XPD1_",",3)=$GET(TXT)
DO FILE^DIE("E","XPD")
+5 QUIT
+6 ;
+7 ;OPT=option name, TXT=Security Key, file 19.1
RLOCK(OPT,TXT) ;Set option Reverse Lock
+1 if $GET(OPT)']""
QUIT
+2 NEW XPD,XPD1
+3 SET XPD1=$$LKOPT(OPT)
if XPD1'>0
QUIT
+4 SET XPD(19,XPD1_",",3.01)=$GET(TXT)
DO FILE^DIE("E","XPD")
+5 QUIT
