source: FOIAVistA/tag/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCMEDT2.m@ 636

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

initial load of FOIAVistA 6/30/08 version
File size: 8.5 KB
Line 
1ORCMEDT2 ;SLC/MKB-Menu Editor cont ;9/4/01 14:38
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**8,46,95**;Dec 17, 1997
3SELECT(ACTION,Y) ; -- Select item from menu
4 N X,XQORM K Y S XQORM=+ORMENU_";"_$J
5 S XQORM(0)="Ah",XQORM("A")="Select Item(s): ",XQORM("??")="D LIST^ORDD41(+ORMENU)"
6 S X="Enter the items you wish to "_ACTION_", either by mnemonic or text.",XQORM("?")="W !,"""_X_""""
7 D EN^XQORM
8 Q
9 ;
10ADDITM ; -- Add new item(s) to menu
11 N DA,DR,DIE,DONE,OREBLD,DLG,ROW,COL,POS
12 D FULL^VALM1 S VALMBCK="R"
13 S DA(1)=+ORMENU,DIE="^ORD(101.41,"_DA(1)_",10,"
14 S:'$D(^ORD(101.41,+ORMENU,10,0)) ^(0)="^101.412AI^^"
15 S (DONE,OREBLD)=0 F D Q:DONE W !
16 . S DLG=$$ITEM^ORCMEDT0 I DLG'>0 S DONE=1 Q
17ADD1 . S ROW=$$ROW Q:ROW="^"
18 . S COL=$$COL Q:COL="^" S POS=ROW_"."_COL
19 . I $D(^ORD(101.41,+ORMENU,10,"B",POS)) W $C(7),!,"There is another item in this position already!" G:'$$SHIFT("down") ADD1 D INSERT(POS)
20 . S DA=$$NEXT(POS) Q:'DA S OREBLD=1
21 . S DR="2////"_DLG_";4;3" D ^DIE
22 I OREBLD W !!,"Rebuilding menu display ..." D INIT^ORCMEDIT S VALMBCK="R"
23 Q
24 ;
25ADDTXT ; -- Add new text to menu
26 N DA,DR,DIE,DONE,OREBLD,TXT,ROW,COL,POS,HDR
27 D FULL^VALM1 S VALMBCK="R",DIE="^ORD(101.41,"_+ORMENU_",10,"
28 S:'$D(^ORD(101.41,+ORMENU,10,0)) ^(0)="^101.412AI^^"
29 S (DONE,OREBLD)=0 F D Q:DONE W !
30 . S TXT=$$TEXT I "^"[TXT S DONE=1 Q
31AT1 . S ROW=$$ROW Q:ROW="^"
32 . S COL=$$COL Q:COL="^" S POS=ROW_"."_COL
33 . I $D(^ORD(101.41,+ORMENU,10,"B",POS)) W $C(7),!,"There is another item in this position already!" G:'$$SHIFT("down") AT1 D INSERT(POS)
34 . S HDR=$$OUTPUT Q:HDR="^"
35 . S DA=$$NEXT(POS) Q:'DA S OREBLD=1
36 . S DR="4///"_TXT_";5///"_HDR D ^DIE
37 I OREBLD W !!,"Rebuilding menu display ..." D INIT^ORCMEDIT S VALMBCK="R"
38 Q
39 ;
40ADDROW ; -- Add new row to menu
41 N X,Y,DIR
42 S DIR(0)="NAO^1:999",DIR("A")="ROW: ",VALMBCK=""
43 S DIR("?")="Enter the number of the row where the new line should appear; all menu items in and below this row number will be shifted down one line."
44 D ^DIR Q:$D(DTOUT)!$D(DUOUT)!(Y="")
45 D INSERT(+Y) S VALMBCK="R"
46 W !!,"Rebuilding menu display ..." D INIT^ORCMEDIT
47 Q
48 ;
49TEXT(X) ; -- Display text
50 N Y,DIR
51 S DIR(0)="FAO^1:80",DIR("A")="DISPLAY TEXT: " S:$L($G(X)) DIR("B")=X
52 S DIR("?",1)="Enter the text to be displayed on this menu. The following characters" ;**95
53 S DIR("?",2)="are not allowed -;,=^ Text longer than the column width will" ;**95
54 S DIR("?")="not wrap and will not display correctly." ;**95
55ASK D ^DIR S:$D(DTOUT)!$D(DUOUT) Y="^" S:X="@" Y=$S($D(DIR("B")):"@",1:"") ;**95
56 I Y'="^" I $$CHKNAM^ORUTL(Y) W $C(7),"??",!,"You may not use these characters in your display text -;,=^" G ASK ;If text doesn't pass input transfrom then ask again **95
57 Q Y
58 ;
59OUTPUT(Z) ; -- Output flag
60 N X,Y,DIR
61 S DIR(0)="YA",DIR("A")="HEADER: ",DIR("B")=$S($G(Z)=2:"YES",1:"NO")
62 S DIR("?")="Enter YES if this text is to be a header, underlined and displaying over the mnemonic; to display this text normally, enter NO."
63 D ^DIR S Z=$S($D(DTOUT)!$D(DUOUT):"^",Y:2,1:1)
64 Q Z
65 ;
66NEXT(POS) ; -- Returns next available DA in ORMENU
67 N I,HDR,LAST,TOTAL,DA
68 S HDR=$G(^ORD(101.41,+ORMENU,10,0)),TOTAL=+$P(HDR,U,4)
69 S LAST=$O(^ORD(101.41,+ORMENU,10,"?"),-1)
70 S I=LAST F I=(I+1):1 Q:'$D(^ORD(101.41,+ORMENU,10,I,0))
71 S DA=I,^ORD(101.41,+ORMENU,10,DA,0)=POS,$P(HDR,U,3,4)=DA_U_(TOTAL+1)
72 S ^ORD(101.41,+ORMENU,99)=$H,^(10,0)=HDR,^("B",POS,DA)=""
73 Q DA
74 ;
75REMOVE ; -- Remove item(s) from menu
76 N DA,DIK,ORY,ORI,ORDEL,ORPOS
77 D FULL^VALM1 S VALMBCK="R"
78 D SELECT("remove",.ORY) Q:ORY'>0 Q:'$$SURE
79 S ORDEL=$$SHIFT("up") Q:ORDEL="^"
80 S DA(1)=+ORMENU,DIK="^ORD(101.41,"_DA(1)_",10,"
81 S ORI=0 F S ORI=$O(ORY(ORI)) Q:'ORI S DA=+ORY(ORI),ORPOS=$P(^ORD(101.41,+ORMENU,10,DA,0),U) D ^DIK,DELETE(ORPOS):ORDEL
82 W !!,"Rebuilding menu display ..." D INIT^ORCMEDIT
83 Q
84 ;
85REMROW ; -- Remove row from menu
86 N X,Y,DIR,ORPOS,ORDEL,OROW,DA,DIK
87 S DIR(0)="NAO^1:999",DIR("A")="ROW: ",VALMBCK=""
88 S DIR("?")="Enter the number of the row to clear items from"
89 D ^DIR Q:$D(DTOUT)!$D(DUOUT)!(Y="") S OROW=+Y Q:'$$SURE
90 S ORDEL=$$SHIFT("up",1) Q:ORDEL="^" S VALMBCK="R"
91 S DA(1)=+ORMENU,DIK="^ORD(101.41,"_DA(1)_",10,"
92 S ORPOS=OROW F S ORPOS=$O(^ORD(101.41,+ORMENU,10,"B",ORPOS)) Q:$P(ORPOS,".")'=OROW S DA=$O(^(ORPOS,0)) D:DA ^DIK
93 D:ORDEL DELETE(OROW)
94 W !!,"Rebuilding menu display ..." D INIT^ORCMEDIT
95 Q
96 ;
97SURE() ; -- Are you sure?
98 N X,Y,DIR W !
99 S DIR(0)="YA",DIR("A")="Are you sure you want to remove these items? "
100 S DIR("?")="Enter YES if you want to remove these items from this menu; NO will cancel this action."
101 D ^DIR
102 Q +Y
103 ;
104MOVE ; -- Move item(s) in menu
105 N STOP,OREBLD,DA,DR,DIE,NODE0,ROW,COL,POS,NEW
106 D FULL^VALM1 S VALMBCK="R"
107 S DA(1)=+ORMENU,DIE="^ORD(101.41,"_DA(1)_",10,"
108 D SELECT("move",.ORY) Q:ORY'>0
109 S (STOP,OREBLD,ORI)=0 F S ORI=$O(ORY(ORI)) Q:ORI'>0 D Q:STOP W !
110 . S DA=+ORY(ORI),NODE0=$G(^ORD(101.41,+ORMENU,10,DA,0)),POS=$P(NODE0,U)
111MV1 . S ROW=$$ROW($P(POS,".")) I ROW="^" S STOP=1 Q
112 . S COL=$$COL($P(POS,".",2)) I COL="^" S STOP=1 Q
113 . S NEW=ROW_"."_COL Q:NEW=POS
114 . I $D(^ORD(101.41,+ORMENU,10,"B",NEW)) W $C(7),!,"There is another item in this position already!" G:'$$SHIFT("down") MV1 D INSERT(NEW)
115 . S OREBLD=1,DR=".01///"_NEW D ^DIE
116 I OREBLD W !!,"Rebuilding menu display ..." D INIT^ORCMEDIT S VALMBCK="R"
117 Q
118 ;
119ROW(X) ; -- Edit row placement
120 N Y,DIR
121 S DIR(0)="NA^1:999",DIR("A")="ROW: " S:$G(X) DIR("B")=X K X
122 S DIR("?")="Enter the row in which you want this item to appear, by number"
123 D ^DIR S:$D(DTOUT)!$D(DUOUT)!(Y="") Y="^"
124 Q Y
125 ;
126COL(X) ; -- Edit column placement
127 N Y,DIR
128 S DIR(0)="NA^1:"_ORCOL,DIR("A")="COLUMN: " S:$G(X) DIR("B")=X K X
129 S DIR("?")="Enter the number of the column in which you want this item to be placed."
130 D ^DIR S:$D(DTOUT)!$D(DUOUT)!(Y="") Y="^"
131 Q Y
132 ;
133SHIFT(DIRECTN,ROW) ; -- Resolve collision
134 N X,Y,DIR
135 S DIR(0)="YA",DIR("B")="YES"
136 S DIR("A")="Do you want to shift items "_$S('$G(ROW):"in this column ",1:"")_DIRECTN_"? "
137 S DIR("?")="Enter YES to move the entries "_$S('$G(ROW):"in this column ",1:"")_DIRECTN_" one line"
138 D ^DIR S:$D(DTOUT)!$D(DUOUT) Y="^"
139 Q Y
140 ;
141INSERT(Y) ; -- Make room for item at position Y
142 N CP,POS,DA S CP=$P(Y,".",2),POS=999.999
143 F S POS=$O(^ORD(101.41,+ORMENU,10,"B",POS),-1) Q:POS<Y I (CP="")!($P(POS,".",2)=CP) S DA=$O(^(POS,0)) D
144 . S X=($P(POS,".")+1)_"."_$P(POS,".",2),$P(^ORD(101.41,+ORMENU,10,DA,0),U)=X
145 . S ^ORD(101.41,+ORMENU,10,"B",X,DA)="" K ^ORD(101.41,+ORMENU,10,"B",POS)
146 Q
147 ;
148DELETE(Y) ; -- Remove item at position Y
149 N CP,POS,DA S POS=Y,CP=$P(Y,".",2)
150 F S POS=$O(^ORD(101.41,+ORMENU,10,"B",POS)) Q:POS'>0 I (CP="")!($P(POS,".",2)=CP) S DA=$O(^(POS,0)) D
151 . S X=($P(POS,".")-1)_"."_$P(POS,".",2),$P(^ORD(101.41,+ORMENU,10,DA,0),U)=X
152 . S ^ORD(101.41,+ORMENU,10,"B",X,DA)="" K ^ORD(101.41,+ORMENU,10,"B",POS)
153 Q
154 ;
155EDIT ; -- Edit item(s) in menu
156 N STOP,OREBLD,DA,DR,DIE,OR0,ORY,ORI,PTR,ROW,COL,POS,NEWPOS,ORDG,P
157 D FULL^VALM1,SELECT("change",.ORY) S VALMBCK="R" Q:ORY'>0
158 S (STOP,OREBLD,ORI)=0 F S ORI=$O(ORY(ORI)) Q:ORI'>0 D Q:STOP W !
159 . S DA=+ORY(ORI),OR0=$G(^ORD(101.41,+ORMENU,10,DA,0)),PTR=+$P(OR0,U,2)
160 . S DIE("NO^")="OUTOK",DA(1)=+ORMENU,DIE="^ORD(101.41,"_DA(1)_",10,"
161 . I PTR S P=$$ITEM^ORCMEDT0(PTR) S:'P STOP=1 I P S DR=$S(P'=PTR:"2////"_P_";",1:"")_"4;3" D ^DIE S:$D(Y) STOP=1 ;^ or timeout
162 . I 'PTR D Q:STOP ;edit #4&5
163 . . N X1,X2 S X1=$P(OR0,U,4),X2=$P(OR0,U,5)
164ED0 . . S X1=$$TEXT($P(OR0,U,4)) I X1="^" S STOP=1 Q
165 . . I X1="@" G:'$$SURE ED0 S DIK=DIE,(STOP,OREBLD)=1 D ^DIK Q
166 . . S X2=$$OUTPUT(X2) S:X2="^" STOP=1,X2=$P(OR0,U,5)
167 . . S ^ORD(101.41,+ORMENU,99)=$H,$P(^(10,DA,0),U,4,5)=X1_U_X2
168 . S:OR0'=$G(^ORD(101.41,+ORMENU,10,DA,0)) OREBLD=1,OR0=$G(^(0))
169 . Q:$G(STOP) S PTR=+$P(OR0,U,2)
170ED1 . S POS=$P(OR0,U),ROW=$$ROW($P(POS,".")) I ROW="^" S STOP=1 Q
171 . S COL=$$COL($P(POS,".",2)) I COL="^" S STOP=1 Q
172 . S NEWPOS=ROW_"."_COL G:POS=NEWPOS ED2 ; no change
173 . I $D(^ORD(101.41,+ORMENU,10,"B",NEWPOS)) W $C(7),!,"There is another item in this position already!" G:'$$SHIFT("down") ED1 D INSERT(NEWPOS)
174 . S OREBLD=1,DR=".01///"_NEWPOS D ^DIE
175ED2 . Q:'PTR S TYPE=$P($G(^ORD(101.41,PTR,0)),U,4),ORDG=+$P($G(^(0)),U,5)
176 . I TYPE'="M",$$EDTITM(TYPE) D QCK0^ORCMEDT1(PTR):TYPE="Q",SET0^ORCMEDT1(PTR):TYPE="O",EN1^ORCMEDT3(PTR):TYPE="D"
177 I OREBLD W !!,"Rebuilding menu display ..." D INIT^ORCMEDIT S VALMBCK="R"
178 Q
179 ;
180EDTITM(X) ; -- Edit item itself?
181 N Y,DIR S DIR(0)="YA",DIR("B")="YES",Y=""
182 S:X="Q" DIR("A")="Edit this quick order? ",DIR("?")="Enter YES to edit the responses in this quick order, or NO to exit."
183 S:X="O" DIR("A")="Edit this order set? ",DIR("?")="Enter YES to edit the orders in this set, or NO to exit."
184 S:X="D" DIR("A")="Edit this order dialog? ",DIR("?")="Enter YES to edit the prompts in this dialog, or NO to exit."
185 I $D(DIR("A")) D ^DIR S:$D(DTOUT)!(X["^") Y="^"
186 Q Y
Note: See TracBrowser for help on using the repository browser.