Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORCMEDT2

ORCMEDT2.m

Go to the documentation of this file.
  1. 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
  1. SELECT(ACTION,Y) ; -- Select item from menu
  1. N X,XQORM K Y S XQORM=+ORMENU_";"_$J
  1. S XQORM(0)="Ah",XQORM("A")="Select Item(s): ",XQORM("??")="D LIST^ORDD41(+ORMENU)"
  1. S X="Enter the items you wish to "_ACTION_", either by mnemonic or text.",XQORM("?")="W !,"""_X_""""
  1. D EN^XQORM
  1. Q
  1. ;
  1. ADDITM ; -- Add new item(s) to menu
  1. N DA,DR,DIE,DONE,OREBLD,DLG,ROW,COL,POS
  1. D FULL^VALM1 S VALMBCK="R"
  1. S DA(1)=+ORMENU,DIE="^ORD(101.41,"_DA(1)_",10,"
  1. S:'$D(^ORD(101.41,+ORMENU,10,0)) ^(0)="^101.412AI^^"
  1. S (DONE,OREBLD)=0 F D Q:DONE W !
  1. . S DLG=$$ITEM^ORCMEDT0 I DLG'>0 S DONE=1 Q
  1. ADD1 . S ROW=$$ROW Q:ROW="^"
  1. . S COL=$$COL Q:COL="^" S POS=ROW_"."_COL
  1. . 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)
  1. . S DA=$$NEXT(POS) Q:'DA S OREBLD=1
  1. . S DR="2////"_DLG_";4;3" D ^DIE
  1. I OREBLD W !!,"Rebuilding menu display ..." D INIT^ORCMEDIT S VALMBCK="R"
  1. Q
  1. ;
  1. ADDTXT ; -- Add new text to menu
  1. N DA,DR,DIE,DONE,OREBLD,TXT,ROW,COL,POS,HDR
  1. D FULL^VALM1 S VALMBCK="R",DIE="^ORD(101.41,"_+ORMENU_",10,"
  1. S:'$D(^ORD(101.41,+ORMENU,10,0)) ^(0)="^101.412AI^^"
  1. S (DONE,OREBLD)=0 F D Q:DONE W !
  1. . S TXT=$$TEXT I "^"[TXT S DONE=1 Q
  1. AT1 . S ROW=$$ROW Q:ROW="^"
  1. . S COL=$$COL Q:COL="^" S POS=ROW_"."_COL
  1. . 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)
  1. . S HDR=$$OUTPUT Q:HDR="^"
  1. . S DA=$$NEXT(POS) Q:'DA S OREBLD=1
  1. . S DR="4///"_TXT_";5///"_HDR D ^DIE
  1. I OREBLD W !!,"Rebuilding menu display ..." D INIT^ORCMEDIT S VALMBCK="R"
  1. Q
  1. ;
  1. ADDROW ; -- Add new row to menu
  1. N X,Y,DIR
  1. S DIR(0)="NAO^1:999",DIR("A")="ROW: ",VALMBCK=""
  1. 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."
  1. D ^DIR Q:$D(DTOUT)!$D(DUOUT)!(Y="")
  1. D INSERT(+Y) S VALMBCK="R"
  1. W !!,"Rebuilding menu display ..." D INIT^ORCMEDIT
  1. Q
  1. ;
  1. TEXT(X) ; -- Display text
  1. N Y,DIR
  1. S DIR(0)="FAO^1:80",DIR("A")="DISPLAY TEXT: " S:$L($G(X)) DIR("B")=X
  1. S DIR("?",1)="Enter the text to be displayed on this menu. The ; and ^ characters" ;**95
  1. S DIR("?",2)="are not allowed. Text longer than the column width will" ;**95
  1. S DIR("?")="not wrap and will not display correctly." ;**95
  1. ASK D ^DIR S:$D(DTOUT)!$D(DUOUT) Y="^;" S:X="@" Y=$S($D(DIR("B")):"@",1:"") ;**95
  1. 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
  1. Q Y
  1. ;
  1. OUTPUT(Z) ; -- Output flag
  1. N X,Y,DIR
  1. S DIR(0)="YA",DIR("A")="HEADER: ",DIR("B")=$S($G(Z)=2:"YES",1:"NO")
  1. 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."
  1. D ^DIR S Z=$S($D(DTOUT)!$D(DUOUT):"^",Y:2,1:1)
  1. Q Z
  1. ;
  1. NEXT(POS) ; -- Returns next available DA in ORMENU
  1. N I,HDR,LAST,TOTAL,DA
  1. S HDR=$G(^ORD(101.41,+ORMENU,10,0)),TOTAL=+$P(HDR,U,4)
  1. S LAST=$O(^ORD(101.41,+ORMENU,10,"?"),-1)
  1. S I=LAST F I=(I+1):1 Q:'$D(^ORD(101.41,+ORMENU,10,I,0))
  1. S DA=I,^ORD(101.41,+ORMENU,10,DA,0)=POS,$P(HDR,U,3,4)=DA_U_(TOTAL+1)
  1. S ^ORD(101.41,+ORMENU,99)=$H,^(10,0)=HDR,^("B",POS,DA)=""
  1. Q DA
  1. ;
  1. REMOVE ; -- Remove item(s) from menu
  1. N DA,DIK,ORY,ORI,ORDEL,ORPOS
  1. D FULL^VALM1 S VALMBCK="R"
  1. D SELECT("remove",.ORY) Q:ORY'>0 Q:'$$SURE
  1. S ORDEL=$$SHIFT("up") Q:ORDEL="^"
  1. S DA(1)=+ORMENU,DIK="^ORD(101.41,"_DA(1)_",10,"
  1. 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
  1. W !!,"Rebuilding menu display ..." D INIT^ORCMEDIT
  1. Q
  1. ;
  1. REMROW ; -- Remove row from menu
  1. N X,Y,DIR,ORPOS,ORDEL,OROW,DA,DIK
  1. S DIR(0)="NAO^1:999",DIR("A")="ROW: ",VALMBCK=""
  1. S DIR("?")="Enter the number of the row to clear items from"
  1. D ^DIR Q:$D(DTOUT)!$D(DUOUT)!(Y="") S OROW=+Y Q:'$$SURE
  1. S ORDEL=$$SHIFT("up",1) Q:ORDEL="^" S VALMBCK="R"
  1. S DA(1)=+ORMENU,DIK="^ORD(101.41,"_DA(1)_",10,"
  1. 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
  1. D:ORDEL DELETE(OROW)
  1. W !!,"Rebuilding menu display ..." D INIT^ORCMEDIT
  1. Q
  1. ;
  1. SURE() ; -- Are you sure?
  1. N X,Y,DIR W !
  1. S DIR(0)="YA",DIR("A")="Are you sure you want to remove these items? "
  1. S DIR("?")="Enter YES if you want to remove these items from this menu; NO will cancel this action."
  1. D ^DIR
  1. Q +Y
  1. ;
  1. MOVE ; -- Move item(s) in menu
  1. N STOP,OREBLD,DA,DR,DIE,NODE0,ROW,COL,POS,NEW
  1. D FULL^VALM1 S VALMBCK="R"
  1. S DA(1)=+ORMENU,DIE="^ORD(101.41,"_DA(1)_",10,"
  1. D SELECT("move",.ORY) Q:ORY'>0
  1. S (STOP,OREBLD,ORI)=0 F S ORI=$O(ORY(ORI)) Q:ORI'>0 D Q:STOP W !
  1. . S DA=+ORY(ORI),NODE0=$G(^ORD(101.41,+ORMENU,10,DA,0)),POS=$P(NODE0,U)
  1. MV1 . S ROW=$$ROW($P(POS,".")) I ROW="^" S STOP=1 Q
  1. . S COL=$$COL($P(POS,".",2)) I COL="^" S STOP=1 Q
  1. . S NEW=ROW_"."_COL Q:NEW=POS
  1. . 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)
  1. . S OREBLD=1,DR=".01///"_NEW D ^DIE
  1. I OREBLD W !!,"Rebuilding menu display ..." D INIT^ORCMEDIT S VALMBCK="R"
  1. Q
  1. ;
  1. ROW(X) ; -- Edit row placement
  1. N Y,DIR
  1. S DIR(0)="NA^1:999",DIR("A")="ROW: " S:$G(X) DIR("B")=X K X
  1. S DIR("?")="Enter the row in which you want this item to appear, by number"
  1. D ^DIR S:$D(DTOUT)!$D(DUOUT)!(Y="") Y="^"
  1. Q Y
  1. ;
  1. COL(X) ; -- Edit column placement
  1. N Y,DIR
  1. S DIR(0)="NA^1:"_ORCOL,DIR("A")="COLUMN: " S:$G(X) DIR("B")=X K X
  1. S DIR("?")="Enter the number of the column in which you want this item to be placed."
  1. D ^DIR S:$D(DTOUT)!$D(DUOUT)!(Y="") Y="^"
  1. Q Y
  1. ;
  1. SHIFT(DIRECTN,ROW) ; -- Resolve collision
  1. N X,Y,DIR
  1. S DIR(0)="YA",DIR("B")="YES"
  1. S DIR("A")="Do you want to shift items "_$S('$G(ROW):"in this column ",1:"")_DIRECTN_"? "
  1. S DIR("?")="Enter YES to move the entries "_$S('$G(ROW):"in this column ",1:"")_DIRECTN_" one line"
  1. D ^DIR S:$D(DTOUT)!$D(DUOUT) Y="^"
  1. Q Y
  1. ;
  1. INSERT(Y) ; -- Make room for item at position Y
  1. N CP,POS,DA S CP=$P(Y,".",2),POS=999.999
  1. 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
  1. . S X=($P(POS,".")+1)_"."_$P(POS,".",2),$P(^ORD(101.41,+ORMENU,10,DA,0),U)=X
  1. . S ^ORD(101.41,+ORMENU,10,"B",X,DA)="" K ^ORD(101.41,+ORMENU,10,"B",POS)
  1. Q
  1. ;
  1. DELETE(Y) ; -- Remove item at position Y
  1. N CP,POS,DA S POS=Y,CP=$P(Y,".",2)
  1. 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
  1. . S X=($P(POS,".")-1)_"."_$P(POS,".",2),$P(^ORD(101.41,+ORMENU,10,DA,0),U)=X
  1. . S ^ORD(101.41,+ORMENU,10,"B",X,DA)="" K ^ORD(101.41,+ORMENU,10,"B",POS)
  1. Q
  1. ;
  1. EDIT ; -- Edit item(s) in menu
  1. N STOP,OREBLD,DA,DR,DIE,OR0,ORY,ORI,PTR,ROW,COL,POS,NEWPOS,ORDG,P
  1. D FULL^VALM1,SELECT("change",.ORY) S VALMBCK="R" Q:ORY'>0
  1. S (STOP,OREBLD,ORI)=0 F S ORI=$O(ORY(ORI)) Q:ORI'>0 D Q:STOP W !
  1. . S DA=+ORY(ORI),OR0=$G(^ORD(101.41,+ORMENU,10,DA,0)),PTR=+$P(OR0,U,2)
  1. . S DIE("NO^")="OUTOK",DA(1)=+ORMENU,DIE="^ORD(101.41,"_DA(1)_",10,"
  1. . 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
  1. . I 'PTR D Q:STOP ;edit #4&5
  1. . . N X1,X2 S X1=$P(OR0,U,4),X2=$P(OR0,U,5)
  1. ED0 . . S X1=$$TEXT($P(OR0,U,4)) I X1="^" S STOP=1 Q
  1. . . I X1="@" G:'$$SURE ED0 S DIK=DIE,(STOP,OREBLD)=1 D ^DIK Q
  1. . . S X2=$$OUTPUT(X2) S:X2="^" STOP=1,X2=$P(OR0,U,5)
  1. . . S ^ORD(101.41,+ORMENU,99)=$H,$P(^(10,DA,0),U,4,5)=X1_U_X2
  1. . S:OR0'=$G(^ORD(101.41,+ORMENU,10,DA,0)) OREBLD=1,OR0=$G(^(0))
  1. . Q:$G(STOP) S PTR=+$P(OR0,U,2)
  1. ED1 . S POS=$P(OR0,U),ROW=$$ROW($P(POS,".")) I ROW="^" S STOP=1 Q
  1. . S COL=$$COL($P(POS,".",2)) I COL="^" S STOP=1 Q
  1. . S NEWPOS=ROW_"."_COL G:POS=NEWPOS ED2 ; no change
  1. . 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)
  1. . S OREBLD=1,DR=".01///"_NEWPOS D ^DIE
  1. ED2 . Q:'PTR S TYPE=$P($G(^ORD(101.41,PTR,0)),U,4),ORDG=+$P($G(^(0)),U,5)
  1. . I TYPE'="M",$$EDTITM(TYPE) D QCK0^ORCMEDT1(PTR):TYPE="Q",SET0^ORCMEDT1(PTR):TYPE="O",EN1^ORCMEDT3(PTR):TYPE="D"
  1. I OREBLD W !!,"Rebuilding menu display ..." D INIT^ORCMEDIT S VALMBCK="R"
  1. Q
  1. ;
  1. EDTITM(X) ; -- Edit item itself?
  1. N Y,DIR S DIR(0)="YA",DIR("B")="YES",Y=""
  1. S:X="Q" DIR("A")="Edit this quick order? ",DIR("?")="Enter YES to edit the responses in this quick order, or NO to exit."
  1. S:X="O" DIR("A")="Edit this order set? ",DIR("?")="Enter YES to edit the orders in this set, or NO to exit."
  1. S:X="D" DIR("A")="Edit this order dialog? ",DIR("?")="Enter YES to edit the prompts in this dialog, or NO to exit."
  1. I $D(DIR("A")) D ^DIR S:$D(DTOUT)!(X["^") Y="^"
  1. Q Y