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