source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORGUEM.m

ORGUEM ; slc/KCM - Set Up Formatted Protocol Menus ;5/28/92 14:41
 ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
 ;;
EN ; Select menu, change items, formatting, & other attributes
 N ORGPOP,ORGMENU,IOINHI,IOINLOW                          ; ORGMENU declared globally for ORGUEM*
 D GMENU^ORGUEM2("AEMQL",.ORGMENU) Q:$D(ORGPOP)           ; Get protocol menu
 I $P(ORGMENU,"^",3) D NEW^ORGUEM2 I $D(ORGPOP) D DMEN Q  ; If creating a new protocol, get required fields
 D HOME^%ZIS S X="IOINHI;IOINLOW" D ENDR^%ZISS
 S ORGMENU("TOG")="F" D SHOW                      ; Show menu in formatted mode
 S X=$O(^ORD(101,"B","ORCL PROTOCOL MENU SETUP",0))_";ORD(101,"
 D EN^XQOR                                        ; Use XQOR to select & execute actions
 D BLANKS^ORGUEM2                                 ; Reset blank lines
 S ^DISV(DUZ,"^ORD(101,")=+ORGMENU
 K ^XUTL("XQORM",+ORGMENU_";"_$J)                 ; Clean up sequence/name menu node
 Q
DMEN ; Delete Protocol Menu (pointers not updated)
 N DA,DIK
 S DA=+ORGMENU,DIK="^ORD(101,"
 W !,"Insufficient information to create menu...."
 D ^DIK
 Q
COL ; Edit the number of columns for the protocol
 N ORCOL,DIR,DIC,DIE,DR,DA
 S ORCOL=80\$S($G(^ORD(101,+ORGMENU,4)):^(4),1:80)
 S DIR(0)="NAO^1:3",DIR("A")="Number of Columns (1-3): ",DIR("B")=ORCOL
 D ^DIR
 I Y,Y'=ORCOL S DR="41///"_(80\Y),DIE="^ORD(101,",DA=+ORGMENU D ^DIE
 Q
MNE ; Edit mnemonic width for the protocol
 N ORMNE,DIR,DIC,DIE,DR,DA
 S ORMNE=$P($G(^ORD(101,+ORGMENU,4)),"^",2)
 S DIR(0)="NAO^1:9",DIR("A")="Width for Mnemonics: ",DIR("B")=$S(ORMNE:ORMNE,1:5)
 D ^DIR
 I Y,Y'=ORMNE S DR="42///"_Y,DIE="^ORD(101,",DA=+ORGMENU D ^DIE
 Q
ADD ; Add a new item to the menu
 N DIC
 S DIC="^ORD(101,",DIC(0)="AEMQZ",DIC("A")="Select Item to be Added: "
 F  D ^DIC Q:Y'>0  D
 . N D0,DD,DIC,DA,DIE,DR
 . S:'$D(^ORD(101,+ORGMENU,10,0)) ^(0)="^101.01PA^^"
 . S X=+Y,DA(1)=+ORGMENU,DIC="^ORD(101,"_DA(1)_",10,",DIC(0)=""
 . D FILE^DICN I +Y S DIE=DIC,DA=+Y,DR="3;2;6" D ^DIE
 Q
EDIT ; Edit an item on the menu
 N ORGIDX,ORGLST,ORGFLG
 S ORGLST=$$LOOK^ORGUEM2("Select item(s) to be edited: ")
 F ORGIDX=1:1:$L(ORGLST,",") I +$P(ORGLST,",",ORGIDX) D FLDS^ORGUEM2(+$P(ORGLST,",",ORGIDX),.ORGFLG) Q:ORGFLG
 Q
DEL ; Delete an item from the menu
 N ORGIDX,ORGLST,DA,DIK
 S ORGLST=$$LOOK^ORGUEM2("Select item(s) to be deleted: ")
 F ORGIDX=1:1:$L(ORGLST,",") D  ;delete item
 . S DA=$P(ORGLST,",",ORGIDX)
 . I DA S DA(1)=+ORGMENU,DIK="^ORD(101,"_DA(1)_",10," D ^DIK
 Q
SHOW ; Display the menu
 N XQORM,X
 W !!,ORGMENU(0,0),?61,$$INHI^XQORM1,"HILITE",$$INLO^XQORM1,"=placeholder"
 W ! F I=1:1:79 W "-"
 D SMENU^ORGUEM2 D:ORGMENU("TOG")="R" SET^ORGUEM1(+ORGMENU) D EN^XQORM
 I ORGMENU("TOG")="F" D
 . W !,$S($D(XQORM("A")):XQORM("A"),1:"Select Item(s): ")
 . W:$D(XQORM("B")) XQORM("B")_"// "
 W ! F I=1:1:79 W "-"
 Q
TOG ; Toggle menu display mode
 I ORGMENU("TOG")="R" S ORGMENU("TOG")="F" W !,"Menus will now be displayed as the user will see them."
 E  S ORGMENU("TOG")="R" W !,"Menus will now be displayed using actual sequence numbers and protocol names."
 Q
OPT ; Edit optional menu parameters
 N DIE,DR,DA
 S DIE="^ORD(101,",DR="[ORCL ADV MENU EDIT]",DA=+ORGMENU D ^DIE
 Q
INQ ; Inquire protocol file
 N DIC,DA,DR,DIQ
 S DIC="^ORD(101,",DIC(0)="AEMQ" D ^DIC Q:Y'>0
 W ! S DA=+Y D EN^DIQ
 Q