XPDMENU.m

XPDMENU ;SFISC/RWF,RSD - Manage Menu items ;07/03/2003  09:12 [ 03/19/2004  12:04 PM ]

 ;;8.0;KERNEL;**21,302,1009**;Jul 10, 1995

 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 menu or extended action

 I "MX"'[$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

XPDMENU   ;SFISC/RWF,RSD - Manage Menu items ;07/03/2003  09:12 [ 03/19/2004  12:04 PM ]

 +1       ;;8.0;KERNEL;**21,302,1009**;Jul 10, 1995

 +2        QUIT 

 +3       ;

 +4       ;MENU=option to add to,  OPT=option to add to MENU, SYN=synonym

 +5       ;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 menu or extended action

 +5        IF "MX"'[$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