ORCMEDT2 ;SLC/MKB-Menu Editor cont ; 15 Dec 2015 10:00 AM
;;3.0;ORDER ENTRY/RESULTS REPORTING;**8,46,95,422**;Dec 17, 1997;Build 2
SELECT(ACTION,Y) ; -- Select item from menu
N X,XQORM K Y S XQORM=+ORMENU_";"_$J
S XQORM(0)="Ah",XQORM("A")="Select Item(s): ",XQORM("??")="D LIST^ORDD41(+ORMENU)"
S X="Enter the items you wish to "_ACTION_", either by mnemonic or text.",XQORM("?")="W !,"""_X_""""
D EN^XQORM
Q
;
ADDITM ; -- Add new item(s) to menu
N DA,DR,DIE,DONE,OREBLD,DLG,ROW,COL,POS
D FULL^VALM1 S VALMBCK="R"
S DA(1)=+ORMENU,DIE="^ORD(101.41,"_DA(1)_",10,"
S:'$D(^ORD(101.41,+ORMENU,10,0)) ^(0)="^101.412AI^^"
S (DONE,OREBLD)=0 F D Q:DONE W !
. S DLG=$$ITEM^ORCMEDT0 I DLG'>0 S DONE=1 Q
ADD1 . S ROW=$$ROW Q:ROW="^"
. S COL=$$COL Q:COL="^" S POS=ROW_"."_COL
. 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)
. S DA=$$NEXT(POS) Q:'DA S OREBLD=1
. S DR="2////"_DLG_";4;3" D ^DIE
I OREBLD W !!,"Rebuilding menu display ..." D INIT^ORCMEDIT S VALMBCK="R"
Q
;
ADDTXT ; -- Add new text to menu
N DA,DR,DIE,DONE,OREBLD,TXT,ROW,COL,POS,HDR
D FULL^VALM1 S VALMBCK="R",DIE="^ORD(101.41,"_+ORMENU_",10,"
S:'$D(^ORD(101.41,+ORMENU,10,0)) ^(0)="^101.412AI^^"
S (DONE,OREBLD)=0 F D Q:DONE W !
. S TXT=$$TEXT I "^"[TXT S DONE=1 Q
AT1 . S ROW=$$ROW Q:ROW="^"
. S COL=$$COL Q:COL="^" S POS=ROW_"."_COL
. 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)
. S HDR=$$OUTPUT Q:HDR="^"
. S DA=$$NEXT(POS) Q:'DA S OREBLD=1
. S DR="4///"_TXT_";5///"_HDR D ^DIE
I OREBLD W !!,"Rebuilding menu display ..." D INIT^ORCMEDIT S VALMBCK="R"
Q
;
ADDROW ; -- Add new row to menu
N X,Y,DIR
S DIR(0)="NAO^1:999",DIR("A")="ROW: ",VALMBCK=""
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."
D ^DIR Q:$D(DTOUT)!$D(DUOUT)!(Y="")
D INSERT(+Y) S VALMBCK="R"
W !!,"Rebuilding menu display ..." D INIT^ORCMEDIT
Q
;
TEXT(X) ; -- Display text
N Y,DIR
S DIR(0)="FAO^1:80",DIR("A")="DISPLAY TEXT: " S:$L($G(X)) DIR("B")=X
S DIR("?",1)="Enter the text to be displayed on this menu. The ; and ^ characters" ;**95
S DIR("?",2)="are not allowed. Text longer than the column width will" ;**95
S DIR("?")="not wrap and will not display correctly." ;**95
ASK D ^DIR S:$D(DTOUT)!$D(DUOUT) Y="^;" S:X="@" Y=$S($D(DIR("B")):"@",1:"") ;**95
I Y'="^" I $$CHKNAM^ORUTL(Y) W $C(7),"??",!,"You may not use the ^ or ; character in your display text." G ASK ;If text doesn't pass input transfrom then ask again **95
Q Y
;
OUTPUT(Z) ; -- Output flag
N X,Y,DIR
S DIR(0)="YA",DIR("A")="HEADER: ",DIR("B")=$S($G(Z)=2:"YES",1:"NO")
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."
D ^DIR S Z=$S($D(DTOUT)!$D(DUOUT):"^",Y:2,1:1)
Q Z
;
NEXT(POS) ; -- Returns next available DA in ORMENU
N I,HDR,LAST,TOTAL,DA
S HDR=$G(^ORD(101.41,+ORMENU,10,0)),TOTAL=+$P(HDR,U,4)
S LAST=$O(^ORD(101.41,+ORMENU,10,"?"),-1)
S I=LAST F I=(I+1):1 Q:'$D(^ORD(101.41,+ORMENU,10,I,0))
S DA=I,^ORD(101.41,+ORMENU,10,DA,0)=POS,$P(HDR,U,3,4)=DA_U_(TOTAL+1)
S ^ORD(101.41,+ORMENU,99)=$H,^(10,0)=HDR,^("B",POS,DA)=""
Q DA
;
REMOVE ; -- Remove item(s) from menu
N DA,DIK,ORY,ORI,ORDEL,ORPOS
D FULL^VALM1 S VALMBCK="R"
D SELECT("remove",.ORY) Q:ORY'>0 Q:'$$SURE
S ORDEL=$$SHIFT("up") Q:ORDEL="^"
S DA(1)=+ORMENU,DIK="^ORD(101.41,"_DA(1)_",10,"
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
W !!,"Rebuilding menu display ..." D INIT^ORCMEDIT
Q
;
REMROW ; -- Remove row from menu
N X,Y,DIR,ORPOS,ORDEL,OROW,DA,DIK
S DIR(0)="NAO^1:999",DIR("A")="ROW: ",VALMBCK=""
S DIR("?")="Enter the number of the row to clear items from"
D ^DIR Q:$D(DTOUT)!$D(DUOUT)!(Y="") S OROW=+Y Q:'$$SURE
S ORDEL=$$SHIFT("up",1) Q:ORDEL="^" S VALMBCK="R"
S DA(1)=+ORMENU,DIK="^ORD(101.41,"_DA(1)_",10,"
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
D:ORDEL DELETE(OROW)
W !!,"Rebuilding menu display ..." D INIT^ORCMEDIT
Q
;
SURE() ; -- Are you sure?
N X,Y,DIR W !
S DIR(0)="YA",DIR("A")="Are you sure you want to remove these items? "
S DIR("?")="Enter YES if you want to remove these items from this menu; NO will cancel this action."
D ^DIR
Q +Y
;
MOVE ; -- Move item(s) in menu
N STOP,OREBLD,DA,DR,DIE,NODE0,ROW,COL,POS,NEW
D FULL^VALM1 S VALMBCK="R"
S DA(1)=+ORMENU,DIE="^ORD(101.41,"_DA(1)_",10,"
D SELECT("move",.ORY) Q:ORY'>0
S (STOP,OREBLD,ORI)=0 F S ORI=$O(ORY(ORI)) Q:ORI'>0 D Q:STOP W !
. S DA=+ORY(ORI),NODE0=$G(^ORD(101.41,+ORMENU,10,DA,0)),POS=$P(NODE0,U)
MV1 . S ROW=$$ROW($P(POS,".")) I ROW="^" S STOP=1 Q
. S COL=$$COL($P(POS,".",2)) I COL="^" S STOP=1 Q
. S NEW=ROW_"."_COL Q:NEW=POS
. 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)
. S OREBLD=1,DR=".01///"_NEW D ^DIE
I OREBLD W !!,"Rebuilding menu display ..." D INIT^ORCMEDIT S VALMBCK="R"
Q
;
ROW(X) ; -- Edit row placement
N Y,DIR
S DIR(0)="NA^1:999",DIR("A")="ROW: " S:$G(X) DIR("B")=X K X
S DIR("?")="Enter the row in which you want this item to appear, by number"
D ^DIR S:$D(DTOUT)!$D(DUOUT)!(Y="") Y="^"
Q Y
;
COL(X) ; -- Edit column placement
N Y,DIR
S DIR(0)="NA^1:"_ORCOL,DIR("A")="COLUMN: " S:$G(X) DIR("B")=X K X
S DIR("?")="Enter the number of the column in which you want this item to be placed."
D ^DIR S:$D(DTOUT)!$D(DUOUT)!(Y="") Y="^"
Q Y
;
SHIFT(DIRECTN,ROW) ; -- Resolve collision
N X,Y,DIR
S DIR(0)="YA",DIR("B")="YES"
S DIR("A")="Do you want to shift items "_$S('$G(ROW):"in this column ",1:"")_DIRECTN_"? "
S DIR("?")="Enter YES to move the entries "_$S('$G(ROW):"in this column ",1:"")_DIRECTN_" one line"
D ^DIR S:$D(DTOUT)!$D(DUOUT) Y="^"
Q Y
;
INSERT(Y) ; -- Make room for item at position Y
N CP,POS,DA S CP=$P(Y,".",2),POS=999.999
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
. S X=($P(POS,".")+1)_"."_$P(POS,".",2),$P(^ORD(101.41,+ORMENU,10,DA,0),U)=X
. S ^ORD(101.41,+ORMENU,10,"B",X,DA)="" K ^ORD(101.41,+ORMENU,10,"B",POS)
Q
;
DELETE(Y) ; -- Remove item at position Y
N CP,POS,DA S POS=Y,CP=$P(Y,".",2)
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
. S X=($P(POS,".")-1)_"."_$P(POS,".",2),$P(^ORD(101.41,+ORMENU,10,DA,0),U)=X
. S ^ORD(101.41,+ORMENU,10,"B",X,DA)="" K ^ORD(101.41,+ORMENU,10,"B",POS)
Q
;
EDIT ; -- Edit item(s) in menu
N STOP,OREBLD,DA,DR,DIE,OR0,ORY,ORI,PTR,ROW,COL,POS,NEWPOS,ORDG,P
D FULL^VALM1,SELECT("change",.ORY) S VALMBCK="R" Q:ORY'>0
S (STOP,OREBLD,ORI)=0 F S ORI=$O(ORY(ORI)) Q:ORI'>0 D Q:STOP W !
. S DA=+ORY(ORI),OR0=$G(^ORD(101.41,+ORMENU,10,DA,0)),PTR=+$P(OR0,U,2)
. S DIE("NO^")="OUTOK",DA(1)=+ORMENU,DIE="^ORD(101.41,"_DA(1)_",10,"
. 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
. I 'PTR D Q:STOP ;edit #4&5
. . N X1,X2 S X1=$P(OR0,U,4),X2=$P(OR0,U,5)
ED0 . . S X1=$$TEXT($P(OR0,U,4)) I X1="^" S STOP=1 Q
. . I X1="@" G:'$$SURE ED0 S DIK=DIE,(STOP,OREBLD)=1 D ^DIK Q
. . S X2=$$OUTPUT(X2) S:X2="^" STOP=1,X2=$P(OR0,U,5)
. . S ^ORD(101.41,+ORMENU,99)=$H,$P(^(10,DA,0),U,4,5)=X1_U_X2
. S:OR0'=$G(^ORD(101.41,+ORMENU,10,DA,0)) OREBLD=1,OR0=$G(^(0))
. Q:$G(STOP) S PTR=+$P(OR0,U,2)
ED1 . S POS=$P(OR0,U),ROW=$$ROW($P(POS,".")) I ROW="^" S STOP=1 Q
. S COL=$$COL($P(POS,".",2)) I COL="^" S STOP=1 Q
. S NEWPOS=ROW_"."_COL G:POS=NEWPOS ED2 ; no change
. 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)
. S OREBLD=1,DR=".01///"_NEWPOS D ^DIE
ED2 . Q:'PTR S TYPE=$P($G(^ORD(101.41,PTR,0)),U,4),ORDG=+$P($G(^(0)),U,5)
. I TYPE'="M",$$EDTITM(TYPE) D QCK0^ORCMEDT1(PTR):TYPE="Q",SET0^ORCMEDT1(PTR):TYPE="O",EN1^ORCMEDT3(PTR):TYPE="D"
I OREBLD W !!,"Rebuilding menu display ..." D INIT^ORCMEDIT S VALMBCK="R"
Q
;
EDTITM(X) ; -- Edit item itself?
N Y,DIR S DIR(0)="YA",DIR("B")="YES",Y=""
S:X="Q" DIR("A")="Edit this quick order? ",DIR("?")="Enter YES to edit the responses in this quick order, or NO to exit."
S:X="O" DIR("A")="Edit this order set? ",DIR("?")="Enter YES to edit the orders in this set, or NO to exit."
S:X="D" DIR("A")="Edit this order dialog? ",DIR("?")="Enter YES to edit the prompts in this dialog, or NO to exit."
I $D(DIR("A")) D ^DIR S:$D(DTOUT)!(X["^") Y="^"
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCMEDT2 8952 printed Oct 16, 2024@18:29:11 Page 2
ORCMEDT2 ;SLC/MKB-Menu Editor cont ; 15 Dec 2015 10:00 AM
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**8,46,95,422**;Dec 17, 1997;Build 2
SELECT(ACTION,Y) ; -- Select item from menu
+1 NEW X,XQORM
KILL Y
SET XQORM=+ORMENU_";"_$JOB
+2 SET XQORM(0)="Ah"
SET XQORM("A")="Select Item(s): "
SET XQORM("??")="D LIST^ORDD41(+ORMENU)"
+3 SET X="Enter the items you wish to "_ACTION_", either by mnemonic or text."
SET XQORM("?")="W !,"""_X_""""
+4 DO EN^XQORM
+5 QUIT
+6 ;
ADDITM ; -- Add new item(s) to menu
+1 NEW DA,DR,DIE,DONE,OREBLD,DLG,ROW,COL,POS
+2 DO FULL^VALM1
SET VALMBCK="R"
+3 SET DA(1)=+ORMENU
SET DIE="^ORD(101.41,"_DA(1)_",10,"
+4 if '$DATA(^ORD(101.41,+ORMENU,10,0))
SET ^(0)="^101.412AI^^"
+5 SET (DONE,OREBLD)=0
FOR
Begin DoDot:1
+6 SET DLG=$$ITEM^ORCMEDT0
IF DLG'>0
SET DONE=1
QUIT
ADD1 SET ROW=$$ROW
if ROW="^"
QUIT
+1 SET COL=$$COL
if COL="^"
QUIT
SET POS=ROW_"."_COL
+2 IF $DATA(^ORD(101.41,+ORMENU,10,"B",POS))
WRITE $CHAR(7),!,"There is another item in this position already!"
if '$$SHIFT("down")
GOTO ADD1
DO INSERT(POS)
+3 SET DA=$$NEXT(POS)
if 'DA
QUIT
SET OREBLD=1
+4 SET DR="2////"_DLG_";4;3"
DO ^DIE
End DoDot:1
if DONE
QUIT
WRITE !
+5 IF OREBLD
WRITE !!,"Rebuilding menu display ..."
DO INIT^ORCMEDIT
SET VALMBCK="R"
+6 QUIT
+7 ;
ADDTXT ; -- Add new text to menu
+1 NEW DA,DR,DIE,DONE,OREBLD,TXT,ROW,COL,POS,HDR
+2 DO FULL^VALM1
SET VALMBCK="R"
SET DIE="^ORD(101.41,"_+ORMENU_",10,"
+3 if '$DATA(^ORD(101.41,+ORMENU,10,0))
SET ^(0)="^101.412AI^^"
+4 SET (DONE,OREBLD)=0
FOR
Begin DoDot:1
+5 SET TXT=$$TEXT
IF "^"[TXT
SET DONE=1
QUIT
AT1 SET ROW=$$ROW
if ROW="^"
QUIT
+1 SET COL=$$COL
if COL="^"
QUIT
SET POS=ROW_"."_COL
+2 IF $DATA(^ORD(101.41,+ORMENU,10,"B",POS))
WRITE $CHAR(7),!,"There is another item in this position already!"
if '$$SHIFT("down")
GOTO AT1
DO INSERT(POS)
+3 SET HDR=$$OUTPUT
if HDR="^"
QUIT
+4 SET DA=$$NEXT(POS)
if 'DA
QUIT
SET OREBLD=1
+5 SET DR="4///"_TXT_";5///"_HDR
DO ^DIE
End DoDot:1
if DONE
QUIT
WRITE !
+6 IF OREBLD
WRITE !!,"Rebuilding menu display ..."
DO INIT^ORCMEDIT
SET VALMBCK="R"
+7 QUIT
+8 ;
ADDROW ; -- Add new row to menu
+1 NEW X,Y,DIR
+2 SET DIR(0)="NAO^1:999"
SET DIR("A")="ROW: "
SET VALMBCK=""
+3 SET 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."
+4 DO ^DIR
if $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
QUIT
+5 DO INSERT(+Y)
SET VALMBCK="R"
+6 WRITE !!,"Rebuilding menu display ..."
DO INIT^ORCMEDIT
+7 QUIT
+8 ;
TEXT(X) ; -- Display text
+1 NEW Y,DIR
+2 SET DIR(0)="FAO^1:80"
SET DIR("A")="DISPLAY TEXT: "
if $LENGTH($GET(X))
SET DIR("B")=X
+3 ;**95
SET DIR("?",1)="Enter the text to be displayed on this menu. The ; and ^ characters"
+4 ;**95
SET DIR("?",2)="are not allowed. Text longer than the column width will"
+5 ;**95
SET DIR("?")="not wrap and will not display correctly."
ASK ;**95
DO ^DIR
if $DATA(DTOUT)!$DATA(DUOUT)
SET Y="^;"
if X="@"
SET Y=$SELECT($DATA(DIR("B")):"@",1:"")
+1 ;If text doesn't pass input transfrom then ask again **95
IF Y'="^"
IF $$CHKNAM^ORUTL(Y)
WRITE $CHAR(7),"??",!,"You may not use the ^ or ; character in your display text."
GOTO ASK
+2 QUIT Y
+3 ;
OUTPUT(Z) ; -- Output flag
+1 NEW X,Y,DIR
+2 SET DIR(0)="YA"
SET DIR("A")="HEADER: "
SET DIR("B")=$SELECT($GET(Z)=2:"YES",1:"NO")
+3 SET DIR("?")="Enter YES if this text is to be a header, underlined and displaying over the mnemonic; to display this text normally, enter NO."
+4 DO ^DIR
SET Z=$SELECT($DATA(DTOUT)!$DATA(DUOUT):"^",Y:2,1:1)
+5 QUIT Z
+6 ;
NEXT(POS) ; -- Returns next available DA in ORMENU
+1 NEW I,HDR,LAST,TOTAL,DA
+2 SET HDR=$GET(^ORD(101.41,+ORMENU,10,0))
SET TOTAL=+$PIECE(HDR,U,4)
+3 SET LAST=$ORDER(^ORD(101.41,+ORMENU,10,"?"),-1)
+4 SET I=LAST
FOR I=(I+1):1
if '$DATA(^ORD(101.41,+ORMENU,10,I,0))
QUIT
+5 SET DA=I
SET ^ORD(101.41,+ORMENU,10,DA,0)=POS
SET $PIECE(HDR,U,3,4)=DA_U_(TOTAL+1)
+6 SET ^ORD(101.41,+ORMENU,99)=$HOROLOG
SET ^(10,0)=HDR
SET ^("B",POS,DA)=""
+7 QUIT DA
+8 ;
REMOVE ; -- Remove item(s) from menu
+1 NEW DA,DIK,ORY,ORI,ORDEL,ORPOS
+2 DO FULL^VALM1
SET VALMBCK="R"
+3 DO SELECT("remove",.ORY)
if ORY'>0
QUIT
if '$$SURE
QUIT
+4 SET ORDEL=$$SHIFT("up")
if ORDEL="^"
QUIT
+5 SET DA(1)=+ORMENU
SET DIK="^ORD(101.41,"_DA(1)_",10,"
+6 SET ORI=0
FOR
SET ORI=$ORDER(ORY(ORI))
if 'ORI
QUIT
SET DA=+ORY(ORI)
SET ORPOS=$PIECE(^ORD(101.41,+ORMENU,10,DA,0),U)
DO ^DIK
if ORDEL
DO DELETE(ORPOS)
+7 WRITE !!,"Rebuilding menu display ..."
DO INIT^ORCMEDIT
+8 QUIT
+9 ;
REMROW ; -- Remove row from menu
+1 NEW X,Y,DIR,ORPOS,ORDEL,OROW,DA,DIK
+2 SET DIR(0)="NAO^1:999"
SET DIR("A")="ROW: "
SET VALMBCK=""
+3 SET DIR("?")="Enter the number of the row to clear items from"
+4 DO ^DIR
if $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
QUIT
SET OROW=+Y
if '$$SURE
QUIT
+5 SET ORDEL=$$SHIFT("up",1)
if ORDEL="^"
QUIT
SET VALMBCK="R"
+6 SET DA(1)=+ORMENU
SET DIK="^ORD(101.41,"_DA(1)_",10,"
+7 SET ORPOS=OROW
FOR
SET ORPOS=$ORDER(^ORD(101.41,+ORMENU,10,"B",ORPOS))
if $PIECE(ORPOS,".")'=OROW
QUIT
SET DA=$ORDER(^(ORPOS,0))
if DA
DO ^DIK
+8 if ORDEL
DO DELETE(OROW)
+9 WRITE !!,"Rebuilding menu display ..."
DO INIT^ORCMEDIT
+10 QUIT
+11 ;
SURE() ; -- Are you sure?
+1 NEW X,Y,DIR
WRITE !
+2 SET DIR(0)="YA"
SET DIR("A")="Are you sure you want to remove these items? "
+3 SET DIR("?")="Enter YES if you want to remove these items from this menu; NO will cancel this action."
+4 DO ^DIR
+5 QUIT +Y
+6 ;
MOVE ; -- Move item(s) in menu
+1 NEW STOP,OREBLD,DA,DR,DIE,NODE0,ROW,COL,POS,NEW
+2 DO FULL^VALM1
SET VALMBCK="R"
+3 SET DA(1)=+ORMENU
SET DIE="^ORD(101.41,"_DA(1)_",10,"
+4 DO SELECT("move",.ORY)
if ORY'>0
QUIT
+5 SET (STOP,OREBLD,ORI)=0
FOR
SET ORI=$ORDER(ORY(ORI))
if ORI'>0
QUIT
Begin DoDot:1
+6 SET DA=+ORY(ORI)
SET NODE0=$GET(^ORD(101.41,+ORMENU,10,DA,0))
SET POS=$PIECE(NODE0,U)
MV1 SET ROW=$$ROW($PIECE(POS,"."))
IF ROW="^"
SET STOP=1
QUIT
+1 SET COL=$$COL($PIECE(POS,".",2))
IF COL="^"
SET STOP=1
QUIT
+2 SET NEW=ROW_"."_COL
if NEW=POS
QUIT
+3 IF $DATA(^ORD(101.41,+ORMENU,10,"B",NEW))
WRITE $CHAR(7),!,"There is another item in this position already!"
if '$$SHIFT("down")
GOTO MV1
DO INSERT(NEW)
+4 SET OREBLD=1
SET DR=".01///"_NEW
DO ^DIE
End DoDot:1
if STOP
QUIT
WRITE !
+5 IF OREBLD
WRITE !!,"Rebuilding menu display ..."
DO INIT^ORCMEDIT
SET VALMBCK="R"
+6 QUIT
+7 ;
ROW(X) ; -- Edit row placement
+1 NEW Y,DIR
+2 SET DIR(0)="NA^1:999"
SET DIR("A")="ROW: "
if $GET(X)
SET DIR("B")=X
KILL X
+3 SET DIR("?")="Enter the row in which you want this item to appear, by number"
+4 DO ^DIR
if $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
SET Y="^"
+5 QUIT Y
+6 ;
COL(X) ; -- Edit column placement
+1 NEW Y,DIR
+2 SET DIR(0)="NA^1:"_ORCOL
SET DIR("A")="COLUMN: "
if $GET(X)
SET DIR("B")=X
KILL X
+3 SET DIR("?")="Enter the number of the column in which you want this item to be placed."
+4 DO ^DIR
if $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
SET Y="^"
+5 QUIT Y
+6 ;
SHIFT(DIRECTN,ROW) ; -- Resolve collision
+1 NEW X,Y,DIR
+2 SET DIR(0)="YA"
SET DIR("B")="YES"
+3 SET DIR("A")="Do you want to shift items "_$SELECT('$GET(ROW):"in this column ",1:"")_DIRECTN_"? "
+4 SET DIR("?")="Enter YES to move the entries "_$SELECT('$GET(ROW):"in this column ",1:"")_DIRECTN_" one line"
+5 DO ^DIR
if $DATA(DTOUT)!$DATA(DUOUT)
SET Y="^"
+6 QUIT Y
+7 ;
INSERT(Y) ; -- Make room for item at position Y
+1 NEW CP,POS,DA
SET CP=$PIECE(Y,".",2)
SET POS=999.999
+2 FOR
SET POS=$ORDER(^ORD(101.41,+ORMENU,10,"B",POS),-1)
if POS<Y
QUIT
IF (CP="")!($PIECE(POS,".",2)=CP)
SET DA=$ORDER(^(POS,0))
Begin DoDot:1
+3 SET X=($PIECE(POS,".")+1)_"."_$PIECE(POS,".",2)
SET $PIECE(^ORD(101.41,+ORMENU,10,DA,0),U)=X
+4 SET ^ORD(101.41,+ORMENU,10,"B",X,DA)=""
KILL ^ORD(101.41,+ORMENU,10,"B",POS)
End DoDot:1
+5 QUIT
+6 ;
DELETE(Y) ; -- Remove item at position Y
+1 NEW CP,POS,DA
SET POS=Y
SET CP=$PIECE(Y,".",2)
+2 FOR
SET POS=$ORDER(^ORD(101.41,+ORMENU,10,"B",POS))
if POS'>0
QUIT
IF (CP="")!($PIECE(POS,".",2)=CP)
SET DA=$ORDER(^(POS,0))
Begin DoDot:1
+3 SET X=($PIECE(POS,".")-1)_"."_$PIECE(POS,".",2)
SET $PIECE(^ORD(101.41,+ORMENU,10,DA,0),U)=X
+4 SET ^ORD(101.41,+ORMENU,10,"B",X,DA)=""
KILL ^ORD(101.41,+ORMENU,10,"B",POS)
End DoDot:1
+5 QUIT
+6 ;
EDIT ; -- Edit item(s) in menu
+1 NEW STOP,OREBLD,DA,DR,DIE,OR0,ORY,ORI,PTR,ROW,COL,POS,NEWPOS,ORDG,P
+2 DO FULL^VALM1
DO SELECT("change",.ORY)
SET VALMBCK="R"
if ORY'>0
QUIT
+3 SET (STOP,OREBLD,ORI)=0
FOR
SET ORI=$ORDER(ORY(ORI))
if ORI'>0
QUIT
Begin DoDot:1
+4 SET DA=+ORY(ORI)
SET OR0=$GET(^ORD(101.41,+ORMENU,10,DA,0))
SET PTR=+$PIECE(OR0,U,2)
+5 SET DIE("NO^")="OUTOK"
SET DA(1)=+ORMENU
SET DIE="^ORD(101.41,"_DA(1)_",10,"
+6 ;^ or timeout
IF PTR
SET P=$$ITEM^ORCMEDT0(PTR)
if 'P
SET STOP=1
IF P
SET DR=$SELECT(P'=PTR:"2////"_P_";",1:"")_"4;3"
DO ^DIE
if $DATA(Y)
SET STOP=1
+7 ;edit #4&5
IF 'PTR
Begin DoDot:2
+8 NEW X1,X2
SET X1=$PIECE(OR0,U,4)
SET X2=$PIECE(OR0,U,5)
ED0 SET X1=$$TEXT($PIECE(OR0,U,4))
IF X1="^"
SET STOP=1
QUIT
+1 IF X1="@"
if '$$SURE
GOTO ED0
SET DIK=DIE
SET (STOP,OREBLD)=1
DO ^DIK
QUIT
+2 SET X2=$$OUTPUT(X2)
if X2="^"
SET STOP=1
SET X2=$PIECE(OR0,U,5)
+3 SET ^ORD(101.41,+ORMENU,99)=$HOROLOG
SET $PIECE(^(10,DA,0),U,4,5)=X1_U_X2
End DoDot:2
if STOP
QUIT
+4 if OR0'=$GET(^ORD(101.41,+ORMENU,10,DA,0))
SET OREBLD=1
SET OR0=$GET(^(0))
+5 if $GET(STOP)
QUIT
SET PTR=+$PIECE(OR0,U,2)
ED1 SET POS=$PIECE(OR0,U)
SET ROW=$$ROW($PIECE(POS,"."))
IF ROW="^"
SET STOP=1
QUIT
+1 SET COL=$$COL($PIECE(POS,".",2))
IF COL="^"
SET STOP=1
QUIT
+2 ; no change
SET NEWPOS=ROW_"."_COL
if POS=NEWPOS
GOTO ED2
+3 IF $DATA(^ORD(101.41,+ORMENU,10,"B",NEWPOS))
WRITE $CHAR(7),!,"There is another item in this position already!"
if '$$SHIFT("down")
GOTO ED1
DO INSERT(NEWPOS)
+4 SET OREBLD=1
SET DR=".01///"_NEWPOS
DO ^DIE
ED2 if 'PTR
QUIT
SET TYPE=$PIECE($GET(^ORD(101.41,PTR,0)),U,4)
SET ORDG=+$PIECE($GET(^(0)),U,5)
+1 IF TYPE'="M"
IF $$EDTITM(TYPE)
if TYPE="Q"
DO QCK0^ORCMEDT1(PTR)
if TYPE="O"
DO SET0^ORCMEDT1(PTR)
if TYPE="D"
DO EN1^ORCMEDT3(PTR)
End DoDot:1
if STOP
QUIT
WRITE !
+2 IF OREBLD
WRITE !!,"Rebuilding menu display ..."
DO INIT^ORCMEDIT
SET VALMBCK="R"
+3 QUIT
+4 ;
EDTITM(X) ; -- Edit item itself?
+1 NEW Y,DIR
SET DIR(0)="YA"
SET DIR("B")="YES"
SET Y=""
+2 if X="Q"
SET DIR("A")="Edit this quick order? "
SET DIR("?")="Enter YES to edit the responses in this quick order, or NO to exit."
+3 if X="O"
SET DIR("A")="Edit this order set? "
SET DIR("?")="Enter YES to edit the orders in this set, or NO to exit."
+4 if X="D"
SET DIR("A")="Edit this order dialog? "
SET DIR("?")="Enter YES to edit the prompts in this dialog, or NO to exit."
+5 IF $DATA(DIR("A"))
DO ^DIR
if $DATA(DTOUT)!(X["^")
SET Y="^"
+6 QUIT Y
