source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORGUEM.m@ 1240

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

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1ORGUEM ; slc/KCM - Set Up Formatted Protocol Menus ;5/28/92 14:41
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
3 ;;
4EN ; Select menu, change items, formatting, & other attributes
5 N ORGPOP,ORGMENU,IOINHI,IOINLOW ; ORGMENU declared globally for ORGUEM*
6 D GMENU^ORGUEM2("AEMQL",.ORGMENU) Q:$D(ORGPOP) ; Get protocol menu
7 I $P(ORGMENU,"^",3) D NEW^ORGUEM2 I $D(ORGPOP) D DMEN Q ; If creating a new protocol, get required fields
8 D HOME^%ZIS S X="IOINHI;IOINLOW" D ENDR^%ZISS
9 S ORGMENU("TOG")="F" D SHOW ; Show menu in formatted mode
10 S X=$O(^ORD(101,"B","ORCL PROTOCOL MENU SETUP",0))_";ORD(101,"
11 D EN^XQOR ; Use XQOR to select & execute actions
12 D BLANKS^ORGUEM2 ; Reset blank lines
13 S ^DISV(DUZ,"^ORD(101,")=+ORGMENU
14 K ^XUTL("XQORM",+ORGMENU_";"_$J) ; Clean up sequence/name menu node
15 Q
16DMEN ; Delete Protocol Menu (pointers not updated)
17 N DA,DIK
18 S DA=+ORGMENU,DIK="^ORD(101,"
19 W !,"Insufficient information to create menu...."
20 D ^DIK
21 Q
22COL ; Edit the number of columns for the protocol
23 N ORCOL,DIR,DIC,DIE,DR,DA
24 S ORCOL=80\$S($G(^ORD(101,+ORGMENU,4)):^(4),1:80)
25 S DIR(0)="NAO^1:3",DIR("A")="Number of Columns (1-3): ",DIR("B")=ORCOL
26 D ^DIR
27 I Y,Y'=ORCOL S DR="41///"_(80\Y),DIE="^ORD(101,",DA=+ORGMENU D ^DIE
28 Q
29MNE ; Edit mnemonic width for the protocol
30 N ORMNE,DIR,DIC,DIE,DR,DA
31 S ORMNE=$P($G(^ORD(101,+ORGMENU,4)),"^",2)
32 S DIR(0)="NAO^1:9",DIR("A")="Width for Mnemonics: ",DIR("B")=$S(ORMNE:ORMNE,1:5)
33 D ^DIR
34 I Y,Y'=ORMNE S DR="42///"_Y,DIE="^ORD(101,",DA=+ORGMENU D ^DIE
35 Q
36ADD ; Add a new item to the menu
37 N DIC
38 S DIC="^ORD(101,",DIC(0)="AEMQZ",DIC("A")="Select Item to be Added: "
39 F D ^DIC Q:Y'>0 D
40 . N D0,DD,DIC,DA,DIE,DR
41 . S:'$D(^ORD(101,+ORGMENU,10,0)) ^(0)="^101.01PA^^"
42 . S X=+Y,DA(1)=+ORGMENU,DIC="^ORD(101,"_DA(1)_",10,",DIC(0)=""
43 . D FILE^DICN I +Y S DIE=DIC,DA=+Y,DR="3;2;6" D ^DIE
44 Q
45EDIT ; Edit an item on the menu
46 N ORGIDX,ORGLST,ORGFLG
47 S ORGLST=$$LOOK^ORGUEM2("Select item(s) to be edited: ")
48 F ORGIDX=1:1:$L(ORGLST,",") I +$P(ORGLST,",",ORGIDX) D FLDS^ORGUEM2(+$P(ORGLST,",",ORGIDX),.ORGFLG) Q:ORGFLG
49 Q
50DEL ; Delete an item from the menu
51 N ORGIDX,ORGLST,DA,DIK
52 S ORGLST=$$LOOK^ORGUEM2("Select item(s) to be deleted: ")
53 F ORGIDX=1:1:$L(ORGLST,",") D ;delete item
54 . S DA=$P(ORGLST,",",ORGIDX)
55 . I DA S DA(1)=+ORGMENU,DIK="^ORD(101,"_DA(1)_",10," D ^DIK
56 Q
57SHOW ; Display the menu
58 N XQORM,X
59 W !!,ORGMENU(0,0),?61,$$INHI^XQORM1,"HILITE",$$INLO^XQORM1,"=placeholder"
60 W ! F I=1:1:79 W "-"
61 D SMENU^ORGUEM2 D:ORGMENU("TOG")="R" SET^ORGUEM1(+ORGMENU) D EN^XQORM
62 I ORGMENU("TOG")="F" D
63 . W !,$S($D(XQORM("A")):XQORM("A"),1:"Select Item(s): ")
64 . W:$D(XQORM("B")) XQORM("B")_"// "
65 W ! F I=1:1:79 W "-"
66 Q
67TOG ; Toggle menu display mode
68 I ORGMENU("TOG")="R" S ORGMENU("TOG")="F" W !,"Menus will now be displayed as the user will see them."
69 E S ORGMENU("TOG")="R" W !,"Menus will now be displayed using actual sequence numbers and protocol names."
70 Q
71OPT ; Edit optional menu parameters
72 N DIE,DR,DA
73 S DIE="^ORD(101,",DR="[ORCL ADV MENU EDIT]",DA=+ORGMENU D ^DIE
74 Q
75INQ ; Inquire protocol file
76 N DIC,DA,DR,DIQ
77 S DIC="^ORD(101,",DIC(0)="AEMQ" D ^DIC Q:Y'>0
78 W ! S DA=+Y D EN^DIQ
79 Q
Note: See TracBrowser for help on using the repository browser.