source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCMEDIT.m@ 631

Last change on this file since 631 was 628, checked in by George Lilly, 14 years ago

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