source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCMEDIT.m@ 619

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

initial load of WorldVistAEHR
File size: 6.0 KB
Line 
1ORCMEDIT ;SLC/MKB-Menu Editor ;4/19/01 11:27
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**8,46,95**;Dec 17, 1997
3EN ; -- start here
4 S ORMENU=$$MENU D:ORMENU EN^VALM("OR MENU EDITOR")
5 Q
6 ;
7NEW ; -- Change menu
8 D FULL^VALM1 S VALMBCK="R",VALMBG=1
9 N X S X=$$MENU(ORMENU)
10 I X,+X'=+ORMENU S ORMENU=X D INIT,HDR
11 Q
12 ;
13MENU(OROLD) ; -- Select/edit [new] menu
14 N DIC,X,Y,DLAYGO,ORNEW,DA,DIK
15MN1 S DIC="^ORD(101.41,",DIC(0)="AEQL",DLAYGO=101.41,DIC("DR")="4///^S X=""M"""
16 S DIC("A")="Select ORDER MENU: ",DIC("S")="I $P(^(0),U,4)=""M"""
17 S:$G(OROLD) DIC("B")=$P(OROLD,U,2) D ^DIC I Y'>0 Q "^"
18 L +^ORD(101.41,+Y,0):1 I '$T W !!,"Another user is currently editing this menu!",! G MN1
19 L +^XUTL("XQORM",+Y_";ORD(101.41,","XQORM PROTECT",$J):1 E W !!,"Cannot access menu at this time - try again later.",! G MN1
20 S ORNEW=Y I $P(ORNEW,U,3),$$COPY("M") D
21 . K DLAYGO,DIC("B") S DIC(0)="AEQZ",DIC("A")="Select MENU TO COPY: "
22 . D ^DIC Q:Y'>0 W !,"Copying menu items ..."
23 . M ^ORD(101.41,+ORNEW,10)=^ORD(101.41,+Y,10) ; menu items
24 . M ^ORD(101.41,+ORNEW,2)=^ORD(101.41,+Y,2) ; description
25 . S:$D(^ORD(101.41,+Y,5)) ^ORD(101.41,+ORNEW,5)=^ORD(101.41,+Y,5)
26 . S X=$P(Y(0),U,2),$P(^ORD(101.41,+ORNEW,0),U,2)=X,^ORD(101.41,"C",$$UP^XLFSTR(X),+ORNEW)="" ; display text
27 . S DA(1)=+ORNEW,DIK="^ORD(101.41,"_+ORNEW_",10,",DIK(1)="2^AD" D ENALL^DIK
28 I $P(ORNEW,U,3) S DA=+ORNEW,DIE="^ORD(101.41,",DR="2;20;51;52;53"_$S($G(DUZ(0))="@":";30;40",1:"") D ^DIE
29 I $G(OROLD) L -^ORD(101.41,+OROLD,0),-^XUTL("XQORM",+OROLD_";ORD(101.41,","XQORM PROTECT",$J)
30 Q ORNEW
31 ;
32COPY(TYPE) ; -- Returns 1 or 0, if new item is to be a copy
33 N X,Y,DIR,ITEM S ITEM=$S(TYPE="M":"menu",TYPE="Q":"quick order",TYPE="O":"order set",1:"order dialog")
34 S DIR(0)="YA",DIR("A")="Do you wish to copy an existing "_ITEM_"? "
35 S DIR("?")="Enter YES to copy the items from an existing "_ITEM_" into this one",DIR("B")="YES"
36 D ^DIR
37 Q +Y
38 ;
39EDIT ; -- Edit menu fields
40 N DA,DR,DIE,OR0,OR5,ORNAME D FULL^VALM1 S VALMBCK="R"
41 S ORNAME=$$NAME^ORCMEDT4(+ORMENU) Q:ORNAME="^"
42 I ORNAME="@" S VALMBCK="Q" Q ;deleted - quit ListMgr
43 S OR0=$G(^ORD(101.41,+ORMENU,0)),OR5=$G(^(5))
44 S DR=".01///^S X=ORNAME;2;20;51;52;53"_$S($G(DUZ(0))="@":";30;40",1:"")
45 S DIE="^ORD(101.41,",DA=+ORMENU D ^DIE
46 I OR0=$G(^ORD(101.41,+ORMENU,0)),OR5=$G(^(5)) Q ; no change
47 W !!,"Rebuilding menu display ..." D INIT,HDR
48 Q
49 ;
50VIEW ; -- Toggle display between Name and Display Text
51 N OR0 S OR0=$G(^TMP("ORMENU",$J,0))
52 S OR0=$P(OR0,U,1,4)_U_$S($P(OR0,U,5)="I":"E",1:"I")
53 S ^TMP("ORMENU",$J,0)=OR0,VALMBCK="R"
54 W !!,"Rebuilding menu display ..." D INIT
55 Q
56 ;
57INIT ; -- init variables and list array
58 N X,ROWS,ROW,COL,CW,MW,POS,CNT,ITEM,IFN,MNEM,TEXT,FLAG,LINE,XQORM,I,NAME,INT,DA,TS
59 S INT=$P($G(^TMP("ORMENU",$J,0)),U,5) ; int/ext flag
60 D CLEAN^VALM10,KILL(+ORMENU) ; kill array for rebuilding
61 S ROWS=$P($O(^ORD(101.41,+ORMENU,10,"B",""),-1),".")
62 S VALMCNT=$S(ROWS>51:ROWS,1:51) ; 3 full screens of row #
63 F ROW=1:1:VALMCNT D ; set-up grid
64 . S X=$S((ROW/10)=(ROW\10):ROW/10,(ROW/5)=(ROW\5):"+",1:"|")
65 . S ^TMP("ORMENU",$J,ROW,0)=X_$$REPEAT^XLFSTR(" ",79)
66 S CW=$P($G(^ORD(101.41,+ORMENU,5)),U),MW=$P($G(^(5)),U,2)
67 S:'CW CW=80 S:'MW MW=5 S XQORM=+ORMENU_";"_$J
68 S CNT=0 G:'$O(^ORD(101.41,+ORMENU,10,0)) INQ ; new menu, no items yet
69IN1 S POS=0 F S POS=$O(^ORD(101.41,+ORMENU,10,"B",POS)) Q:POS'>0 S DA=0 F S DA=$O(^ORD(101.41,+ORMENU,10,"B",POS,DA)) Q:'DA D
70 . S ROW=$P(POS,"."),COL=$$COLUMN($P(POS,".",2),CW)
71 . S ITEM=$G(^ORD(101.41,+ORMENU,10,DA,0)),IFN=$P(ITEM,U,2)
72 . S MNEM=$P(ITEM,U,3),FLAG=$P(ITEM,U,5) S:IFN ITM=$G(^ORD(101.41,IFN,0))
73 . I INT="I" S TEXT=$S(IFN:$P(ITM,U),1:"")
74 . I INT'="I" S TEXT=$P(ITEM,U,4) I '$L(TEXT),IFN S TEXT=$P(ITM,U,2)
75 . Q:'$L(TEXT) I FLAG=2 S TEXT=$E(TEXT,1,CW),X=TEXT D SETVIDEO(ROW,COL+1,$L($G(TEXT)),IOUON,IOUOFF)
76 . I FLAG<2 S X=MNEM_$E(" ",1,MW-$L(MNEM))_$E(TEXT,1,CW-MW) D SETVIDEO(ROW,COL+1,MW,IOINHI,IOINORM)
77 . S LINE=$G(^TMP("ORMENU",$J,ROW,0)),^TMP("ORMENU",$J,ROW,0)=$$SETSTR^VALM1(X,LINE,COL+1,CW),CNT=CNT+1,TEXT=$$STRIP(TEXT) Q:'$L(TEXT)
78 . S ^TMP("ORMENU",$J,"B",$$UP(TEXT))=DA S:$L(MNEM) ^($$UP(MNEM))=DA
79 . S ^XUTL("XQORM",XQORM,POS,0)=DA_U_IFN_U_TEXT_U_MNEM,^XUTL("XQORM",XQORM,"B",$$UP(TEXT),POS)="" S:$L(MNEM) ^XUTL("XQORM",XQORM,"B",$$UP(MNEM),POS)=1
80 . I IFN,INT'="I" S NAME=$P(ITM,U) S:$L(NAME) ^XUTL("XQORM",XQORM,"B",$$UP(NAME),POS)=1
81INQ S ^TMP("ORMENU",$J,0)=ROWS_U_CNT_U_CW_U_MW_U_INT ;,VALMBG=1
82 M ^TMP("VALM VIDEO",$J,VALMEVL)=^TMP("ORMENU",$J,"VIDEO")
83 S X="" F I=1:1 S COL=(I-1)*CW+1 Q:COL>80 S $E(X,COL)=I,ORCOL=I
84 D CHGCAP^VALM("LINE",X) S TS=$G(^ORD(101.41,+ORMENU,99)) ; set caption heading
85 S:$D(^XUTL("XQORM",XQORM)) ^(XQORM,"COL")=ORCOL,^(0)=TS
86 Q
87 ;
88SETVIDEO(ROW,COL,WIDTH,ON,OFF) ; -- Set video attributes
89 S ^TMP("ORMENU",$J,"VIDEO",ROW,COL,WIDTH)=ON
90 S ^TMP("ORMENU",$J,"VIDEO",ROW,COL+WIDTH,0)=OFF
91 Q
92 ;
93UP(X) ; -- Convert X to uppercase
94 Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
95 ;
96STRIP(X) ; -- Strip leading spaces from text X
97 N I,Y S Y=""
98 F I=1:1:$L(X) I $E(X,I)'=" " S Y=$E(X,I,999) Q
99 Q Y
100 ;
101COLUMN(NUM,WIDTH) ; -- Returns position for column NUM per WIDTH
102 N Y S:'$G(NUM) NUM=1 S:'$G(WIDTH) WIDTH=80
103 S Y=(NUM-1)*WIDTH+1
104 Q Y
105 ;
106HDR ; -- header code
107 N X,Y S X="Menu: "_$P(ORMENU,U,2)
108 S Y="Column Width: "_$P($G(^TMP("ORMENU",$J,0)),U,3)
109 S VALMHDR(1)=X_$$REPEAT^XLFSTR(" ",79-$L(X)-$L(Y))_Y
110 Q
111 ;
112HELP ; -- help code
113 N X D FULL^VALM1 S VALMBCK="R"
114 W !," This is how this menu will appear to the user in the Add New Orders"
115 W !," option. Select ADD, REMOVE, or EDIT to make changes to this menu, or"
116 W !," ASSIGN to set it as the default for users. Use the ORDER DIALOGS option"
117 W !," to change or create quick orders for this menu."
118 W !,"Press <return> to continue ..." R X:DTIME
119 Q
120 ;
121MSG() ; -- Msg bar
122 Q "+ Next Screen - Prev Screen ?? More Actions"
123 ;
124EXIT ; -- exit code
125 L -^ORD(101.41,+ORMENU,0),-^XUTL("XQORM",+ORMENU_";ORD(101.41,","XQORM PROTECT",$J)
126 D KILL(+ORMENU) K VALMHDR,VALMCNT,VALMBG,ORMENU,ORCOL,^TMP("ORMENU",$J)
127 Q
128 ;
129KILL(DA) ; -- Cleanup compiled menu from editor
130 K ^XUTL("XQORM",DA_";"_$J)
131 Q
Note: See TracBrowser for help on using the repository browser.