- 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 Feb 18, 2025@23:55:10 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