- ORCMEDT1 ;SLC/MKB-QO,Set editor ;02/25/08
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**8,46,57,95,110,245,243,296**;Dec 17, 1997;Build 19
- OI ; -- Enter/edit generic orderable items
- N X,Y,DA,DR,DIE,DIC,ID,DLAYGO,ORDG
- F S ORDG=$$DGRP Q:ORDG'>0 D W !!
- . F S D="S."_$P(ORDG,U,4) D Q:Y'>0 S DA=+Y,ID=DA_";99ORD",DR=".01"_$S($P(Y,U,3):";2///^S X=ID;5////"_+ORDG,1:"") D ^DIE W ! ;110
- .. S DIC="^ORD(101.43,",DIC(0)="AEQL",DLAYGO=101.43,DIE=DIC D IX^DIC ;110
- Q
- ;
- DGRP() ; -- Returns sub-display group of Nursing or Other for generic OI
- N X,Y,DIC,ORGRP,ORDG,ORI
- F ORI="NURS","OTHER" S ORDG=+$O(^ORD(100.98,"B",ORI,0)) D DG^ORCHANG1(ORDG,"BILD",.ORGRP)
- S DIC="^ORD(100.98,",DIC(0)="AEQ",DIC("S")="I $D(ORGRP(+Y))"
- S DIC("A")="Type of Orderable: " D ^DIC
- S:Y>0 Y=+Y_U_$G(^ORD(100.98,+Y,0))
- Q Y
- ;
- QUICK ; -- Enter/edit quick order dialogs
- N ORQDLG,ORDG
- F S ORQDLG=$$DIALOG^ORCMEDT0("Q") Q:ORQDLG="^" D QCK0(ORQDLG) W !
- Q
- QCK0(ORQDLG) ; -- edit quick order ORQDLG
- N ORDIALOG,DA,DR,DIE,DIDEL,ORQUIT,ORVP,ORL,ACTION,FIRST,ORTYPE,ORNAME,X,Y,BEFORCRC,AFTERCRC
- Q:'$G(ORQDLG) S DA=ORQDLG,(ORVP,ORL)=0,FIRST=1,ORTYPE="Z"
- S ORNAME=$$NAME^ORCMEDT4(ORQDLG) Q:(ORNAME="@")!(ORNAME="^") ;deleted,^
- S BEFORCRC=$$RAWCRC^ORCMEDT8(ORQDLG)
- S DR=".01///^S X=ORNAME;2;8;20"_$S(DUZ(0)="@":";30",1:""),DIE="^ORD(101.41,"
- D ^DIE G:$D(Y)!$D(DTOUT) QR D GETQDLG^ORCD(ORQDLG) G:'$G(ORDIALOG) QR
- I '$P($G(^ORD(101.41,ORQDLG,0)),U,7) S X=+$P($G(^ORD(101.41,+ORDIALOG,0)),U,7) S:X $P(^ORD(101.41,ORQDLG,0),U,7)=X,^ORD(101.41,"APKG",X,ORQDLG)=""
- W ! I $D(^ORD(101.41,+ORDIALOG,3.1)) X ^(3.1) G:$G(ORQUIT) QQ
- Q1 D DIALOG^ORCDLG G:$G(ORQUIT) QQ
- D DISPLAY^ORCDLG S ACTION=$$OK G:ACTION="^" QQ
- D:ACTION="P" SAVE^ORCMEDT0,AUTO(ORQDLG) I ACTION="E" S FIRST=0 G Q1 ;fall thru if "C"
- QQ X:$D(^ORD(101.41,+ORDIALOG,4)) ^(4)
- QR S AFTERCRC=$$RAWCRC^ORCMEDT8(ORQDLG)
- I BEFORCRC'=AFTERCRC D UPDQNAME^ORCMEDT8(ORQDLG) ; Rename personal quick order if modified
- Q
- ;
- OK() ; -- Ready to save?
- N X,Y,DIR S DIR(0)="SAM^P:PLACE;E:EDIT;C:CANCEL;",DIR("B")="PLACE"
- S DIR("A")="(P)lace, (E)dit, or (C)ancel this quick order? "
- S DIR("?")="Enter P to save this quick order, or E to change any of the displayed values; enter C to quit without saving these responses"
- D ^DIR S:$D(DTOUT) Y="^"
- Q Y
- ;
- SAVE G SAVE^ORCMEDT0
- ;
- AUTO(DLG) ; -- set AutoAccept flag for GUI
- N X,Y,DIR
- I $$VBQO^ORWDXM4(+DLG)=0 S $P(^ORD(101.41,+DLG,5),U,8)="" Q
- I $$VALQO^ORWDXM3(+DLG)=0 S $P(^ORD(101.41,+DLG,5),U,8)="" Q
- S DIR(0)="YA",DIR("A")="Auto-accept this order? "
- S DIR("B")=$S($P($G(^ORD(101.41,+DLG,5)),U,8):"YES",1:"NO")
- S DIR("?")="Enter YES if this order can be placed simply by selecting it, or NO if the dialog should be presented to complete the order."
- D ^DIR S:Y=1!(Y=0) $P(^ORD(101.41,+DLG,5),U,8)=$S(Y:1,1:"")
- I $P($G(^ORD(101.41,+DLG,0)),"^",8)'=1&($P($G(^(0)),"^",9)=2)&(Y) D EXPLAIN S $P(^ORD(101.41,+DLG,5),"^",8)="" ;Reset auto-accept to no if explanation required.
- Q
- ;
- SET ; -- Order Sets
- N ORSET,ORDG
- F S ORSET=$$DIALOG^ORCMEDT0("O") Q:ORSET="^" D SET0(ORSET) W !
- Q
- SET0(ORSET) ; -- edit order set ORSET
- N DA,DR,DIE,DIC,DIK,X,Y,SEQ,ITM,LCNT,QUIT,ORNAME Q:'$G(ORSET)
- S ORNAME=$$NAME^ORCMEDT4(ORSET) Q:(ORNAME="@")!(ORNAME="^") ;deleted,^
- S DR=".01///^S X=ORNAME;2;20"_$S(DUZ(0)="@":";30;40",1:""),DA=ORSET
- S DIE="^ORD(101.41," D ^DIE Q:$D(Y) Q:'$G(DA)
- S1 I $O(^ORD(101.41,+ORSET,10,0)) D Q:QUIT ;Show existing components
- . W !,"ORDER SET COMPONENTS:" S (SEQ,LCNT,QUIT)=0
- . S DIK="^ORD(101.41,"_+ORSET_",10,",DA(1)=+ORSET ;just in case
- . F S SEQ=$O(^ORD(101.41,+ORSET,10,"B",SEQ)) Q:SEQ'>0 D
- . . S DA=0 F S DA=$O(^ORD(101.41,+ORSET,10,"B",SEQ,DA)) Q:DA'>0 D
- . . . S ITM=$P($G(^ORD(101.41,+ORSET,10,DA,0)),U,2) I ITM'>0 D ^DIK Q
- . . . S LCNT=LCNT+1 I LCNT>(IOSL-3) R !,"Press <return> to continue ...",X:DTIME S LCNT=0 I X["^" S QUIT=1 Q
- . . . W !?3,SEQ,?10,$P(^ORD(101.41,ITM,0),U)
- S2 S QUIT=0 F D Q:QUIT W ! ;Enter/edit components
- . S DIC="^ORD(101.41,"_+ORSET_",10,",DIC(0)="AEQLM",D="B^D"
- . S DIC("A")="Select COMPONENT SEQUENCE#: ",DIC("P")=$P(^DD(101.41,10,0),U,2)
- . K DA S DA(1)=+ORSET D MIX^DIC1 I Y'>0 S QUIT=1 Q
- . S DA=+Y,DIE=DIC,DR=".01;2R" D ^DIE Q:'$G(DA)
- . I $D(^ORD(101.41,+ORSET,10,DA,0)),'$P(^(0),U,2) S DIK=DIE D ^DIK
- Q
- ;
- PROTOCOL ; -- Convert additional protocols to dialogs
- N X,Y,DIC,ORERR
- F S DIC="^ORD(101,",DIC(0)="AEQM" D ^DIC Q:Y'>0 D W !
- . S ORP=+Y,ORM=$$MENU Q:ORM="^" ; What about "^^"-jumping? (ORWARD)
- . W !,"Converting ..." D ONE(ORP,ORM,.ORERR) I '$G(ORERR) W " done." Q
- . W " unable to convert.",!,">> "_$P(ORERR,U,2) K ORERR
- Q
- ONE(PITEM,ORADD,ERROR) ; -- Convert single item protocol, add to menu(s)
- N PMENU,DMENU,NAME,ORPOS,POS,XUTL,DA,DIK
- I $D(^ORD(100.99,1,101.41,PITEM,0)) S DA=PITEM,DA(1)=1,DIK="^ORD(100.99,1,101.41," D ^DIK ; delete error entry
- S NAME=$P($G(^ORD(101,PITEM,0)),U),DITEM=$$ITEM^ORCONVRT(PITEM)
- I 'DITEM!$D(^ORD(100.99,1,101.41,PITEM,0)) S ERROR=$G(^(0)) Q
- Q:'$G(ORADD) ;to add, may enter here with PITEM & DITEM defined
- ADD S PMENU=0 F S PMENU=$O(^ORD(101,"AD",PITEM,PMENU)) Q:PMENU'>0 D W "."
- . S DMENU=$O(^ORD(101.41,"AB",$P(^ORD(101,PMENU,0),U),0)) Q:'DMENU
- . S ORPOS=$$FINDXUTL(PMENU,PITEM) Q:'ORPOS
- . S XUTL=$G(^XUTL("XQORM",PMENU_";ORD(101,",ORPOS,0))
- . S DA=$O(^ORD(101.41,DMENU,10,"B",ORPOS,0)) I DA Q:$P(^ORD(101.41,DMENU,10,DA,0),U,2)=DITEM S POS=$O(^ORD(101.41,DMENU,10,"B",""),-1),ORPOS=($P(POS,".")+1)_".1",DA="" ; move to end, if collision
- . S DA=$$NEXT^ORCONVRT(DMENU)
- . S ^ORD(101.41,DMENU,10,DA,0)=ORPOS_U_DITEM_U_$P(XUTL,U,4)_U_$S($P(XUTL,U,3)'=$P(^ORD(101.41,DITEM,0),U,2):$P(XUTL,U,3),1:"")
- . S ^ORD(101.41,DMENU,10,"B",ORPOS,DA)="",^ORD(101.41,DMENU,10,"D",DITEM,DA)=""
- . S ^ORD(101.41,"AD",DITEM,DMENU,DA)="",^ORD(101.41,DMENU,99)=$H
- Q
- ;
- FINDXUTL(MENU,ITEM) ; -- Returns position of ITEM in MENU
- N XQORM,POS
- S XQORM=MENU_";ORD(101," D XREF^XQORM
- S POS=0 F S POS=$O(^XUTL("XQORM",XQORM,POS)) Q:POS'>0 I $P(^(POS,0),U,2)=ITEM Q
- Q POS
- ;
- N X,Y,DIR S DIR(0)="YA"
- S DIR("A")="Add this item to the same menus again? ",DIR("B")="YES"
- S DIR("?")="Enter YES to have this item placed on the same menus in the Order Dialog file as it was in the Protocol file"
- D ^DIR S:$D(DTOUT) Y="^"
- Q Y
- EXPLAIN ;Give reason why user can't set auto-accept to yes
- W !!,"The combination of VERIFY set to NO and ASK FOR ANOTHER ORDER set to",!,"YES, DON'T ASK and AUTO-ACCEPT set to YES is not allowed."
- W !!,"This combination of settings could cause CPRS to enter into an infinite loop",!,"creating the same order over and over. If you wish to have"
- W !,"AUTO-ACCEPT set to YES you must change one of the other two fields",!,"to a different value.",!!,"AUTO-ACCEPT is being set to NO for you."
- Q
- ORCMEDT1 ;SLC/MKB-QO,Set editor ;02/25/08
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**8,46,57,95,110,245,243,296**;Dec 17, 1997;Build 19
- OI ; -- Enter/edit generic orderable items
- +1 NEW X,Y,DA,DR,DIE,DIC,ID,DLAYGO,ORDG
- +2 FOR
- SET ORDG=$$DGRP
- IF ORDG'>0
- QUIT
- Begin DoDot:1
- +3 ;110
- FOR
- SET D="S."_$PIECE(ORDG,U,4)
- Begin DoDot:2
- +4 ;110
- SET DIC="^ORD(101.43,"
- SET DIC(0)="AEQL"
- SET DLAYGO=101.43
- SET DIE=DIC
- DO IX^DIC
- End DoDot:2
- IF Y'>0
- QUIT
- SET DA=+Y
- SET ID=DA_";99ORD"
- SET DR=".01"_$SELECT($PIECE(Y,U,3):";2///^S X=ID;5////"_+ORDG,1:"")
- DO ^DIE
- WRITE !
- End DoDot:1
- WRITE !!
- +5 QUIT
- +6 ;
- DGRP() ; -- Returns sub-display group of Nursing or Other for generic OI
- +1 NEW X,Y,DIC,ORGRP,ORDG,ORI
- +2 FOR ORI="NURS","OTHER"
- SET ORDG=+$ORDER(^ORD(100.98,"B",ORI,0))
- DO DG^ORCHANG1(ORDG,"BILD",.ORGRP)
- +3 SET DIC="^ORD(100.98,"
- SET DIC(0)="AEQ"
- SET DIC("S")="I $D(ORGRP(+Y))"
- +4 SET DIC("A")="Type of Orderable: "
- DO ^DIC
- +5 IF Y>0
- SET Y=+Y_U_$GET(^ORD(100.98,+Y,0))
- +6 QUIT Y
- +7 ;
- QUICK ; -- Enter/edit quick order dialogs
- +1 NEW ORQDLG,ORDG
- +2 FOR
- SET ORQDLG=$$DIALOG^ORCMEDT0("Q")
- IF ORQDLG="^"
- QUIT
- DO QCK0(ORQDLG)
- WRITE !
- +3 QUIT
- QCK0(ORQDLG) ; -- edit quick order ORQDLG
- +1 NEW ORDIALOG,DA,DR,DIE,DIDEL,ORQUIT,ORVP,ORL,ACTION,FIRST,ORTYPE,ORNAME,X,Y,BEFORCRC,AFTERCRC
- +2 IF '$GET(ORQDLG)
- QUIT
- SET DA=ORQDLG
- SET (ORVP,ORL)=0
- SET FIRST=1
- SET ORTYPE="Z"
- +3 ;deleted,^
- SET ORNAME=$$NAME^ORCMEDT4(ORQDLG)
- IF (ORNAME="@")!(ORNAME="^")
- QUIT
- +4 SET BEFORCRC=$$RAWCRC^ORCMEDT8(ORQDLG)
- +5 SET DR=".01///^S X=ORNAME;2;8;20"_$SELECT(DUZ(0)="@":";30",1:"")
- SET DIE="^ORD(101.41,"
- +6 DO ^DIE
- IF $DATA(Y)!$DATA(DTOUT)
- GOTO QR
- DO GETQDLG^ORCD(ORQDLG)
- IF '$GET(ORDIALOG)
- GOTO QR
- +7 IF '$PIECE($GET(^ORD(101.41,ORQDLG,0)),U,7)
- SET X=+$PIECE($GET(^ORD(101.41,+ORDIALOG,0)),U,7)
- IF X
- SET $PIECE(^ORD(101.41,ORQDLG,0),U,7)=X
- SET ^ORD(101.41,"APKG",X,ORQDLG)=""
- +8 WRITE !
- IF $DATA(^ORD(101.41,+ORDIALOG,3.1))
- XECUTE ^(3.1)
- IF $GET(ORQUIT)
- GOTO QQ
- Q1 DO DIALOG^ORCDLG
- IF $GET(ORQUIT)
- GOTO QQ
- +1 DO DISPLAY^ORCDLG
- SET ACTION=$$OK
- IF ACTION="^"
- GOTO QQ
- +2 ;fall thru if "C"
- IF ACTION="P"
- DO SAVE^ORCMEDT0
- DO AUTO(ORQDLG)
- IF ACTION="E"
- SET FIRST=0
- GOTO Q1
- QQ IF $DATA(^ORD(101.41,+ORDIALOG,4))
- XECUTE ^(4)
- QR SET AFTERCRC=$$RAWCRC^ORCMEDT8(ORQDLG)
- +1 ; Rename personal quick order if modified
- IF BEFORCRC'=AFTERCRC
- DO UPDQNAME^ORCMEDT8(ORQDLG)
- +2 QUIT
- +3 ;
- OK() ; -- Ready to save?
- +1 NEW X,Y,DIR
- SET DIR(0)="SAM^P:PLACE;E:EDIT;C:CANCEL;"
- SET DIR("B")="PLACE"
- +2 SET DIR("A")="(P)lace, (E)dit, or (C)ancel this quick order? "
- +3 SET DIR("?")="Enter P to save this quick order, or E to change any of the displayed values; enter C to quit without saving these responses"
- +4 DO ^DIR
- IF $DATA(DTOUT)
- SET Y="^"
- +5 QUIT Y
- +6 ;
- SAVE GOTO SAVE^ORCMEDT0
- +1 ;
- AUTO(DLG) ; -- set AutoAccept flag for GUI
- +1 NEW X,Y,DIR
- +2 IF $$VBQO^ORWDXM4(+DLG)=0
- SET $PIECE(^ORD(101.41,+DLG,5),U,8)=""
- QUIT
- +3 IF $$VALQO^ORWDXM3(+DLG)=0
- SET $PIECE(^ORD(101.41,+DLG,5),U,8)=""
- QUIT
- +4 SET DIR(0)="YA"
- SET DIR("A")="Auto-accept this order? "
- +5 SET DIR("B")=$SELECT($PIECE($GET(^ORD(101.41,+DLG,5)),U,8):"YES",1:"NO")
- +6 SET DIR("?")="Enter YES if this order can be placed simply by selecting it, or NO if the dialog should be presented to complete the order."
- +7 DO ^DIR
- IF Y=1!(Y=0)
- SET $PIECE(^ORD(101.41,+DLG,5),U,8)=$SELECT(Y:1,1:"")
- +8 ;Reset auto-accept to no if explanation required.
- IF $PIECE($GET(^ORD(101.41,+DLG,0)),"^",8)'=1&($PIECE($GET(^(0)),"^",9)=2)&(Y)
- DO EXPLAIN
- SET $PIECE(^ORD(101.41,+DLG,5),"^",8)=""
- +9 QUIT
- +10 ;
- SET ; -- Order Sets
- +1 NEW ORSET,ORDG
- +2 FOR
- SET ORSET=$$DIALOG^ORCMEDT0("O")
- IF ORSET="^"
- QUIT
- DO SET0(ORSET)
- WRITE !
- +3 QUIT
- SET0(ORSET) ; -- edit order set ORSET
- +1 NEW DA,DR,DIE,DIC,DIK,X,Y,SEQ,ITM,LCNT,QUIT,ORNAME
- IF '$GET(ORSET)
- QUIT
- +2 ;deleted,^
- SET ORNAME=$$NAME^ORCMEDT4(ORSET)
- IF (ORNAME="@")!(ORNAME="^")
- QUIT
- +3 SET DR=".01///^S X=ORNAME;2;20"_$SELECT(DUZ(0)="@":";30;40",1:"")
- SET DA=ORSET
- +4 SET DIE="^ORD(101.41,"
- DO ^DIE
- IF $DATA(Y)
- QUIT
- IF '$GET(DA)
- QUIT
- S1 ;Show existing components
- IF $ORDER(^ORD(101.41,+ORSET,10,0))
- Begin DoDot:1
- +1 WRITE !,"ORDER SET COMPONENTS:"
- SET (SEQ,LCNT,QUIT)=0
- +2 ;just in case
- SET DIK="^ORD(101.41,"_+ORSET_",10,"
- SET DA(1)=+ORSET
- +3 FOR
- SET SEQ=$ORDER(^ORD(101.41,+ORSET,10,"B",SEQ))
- IF SEQ'>0
- QUIT
- Begin DoDot:2
- +4 SET DA=0
- FOR
- SET DA=$ORDER(^ORD(101.41,+ORSET,10,"B",SEQ,DA))
- IF DA'>0
- QUIT
- Begin DoDot:3
- +5 SET ITM=$PIECE($GET(^ORD(101.41,+ORSET,10,DA,0)),U,2)
- IF ITM'>0
- DO ^DIK
- QUIT
- +6 SET LCNT=LCNT+1
- IF LCNT>(IOSL-3)
- READ !,"Press <return> to continue ...",X:DTIME
- SET LCNT=0
- IF X["^"
- SET QUIT=1
- QUIT
- +7 WRITE !?3,SEQ,?10,$PIECE(^ORD(101.41,ITM,0),U)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- IF QUIT
- QUIT
- S2 ;Enter/edit components
- SET QUIT=0
- FOR
- Begin DoDot:1
- +1 SET DIC="^ORD(101.41,"_+ORSET_",10,"
- SET DIC(0)="AEQLM"
- SET D="B^D"
- +2 SET DIC("A")="Select COMPONENT SEQUENCE#: "
- SET DIC("P")=$PIECE(^DD(101.41,10,0),U,2)
- +3 KILL DA
- SET DA(1)=+ORSET
- DO MIX^DIC1
- IF Y'>0
- SET QUIT=1
- QUIT
- +4 SET DA=+Y
- SET DIE=DIC
- SET DR=".01;2R"
- DO ^DIE
- IF '$GET(DA)
- QUIT
- +5 IF $DATA(^ORD(101.41,+ORSET,10,DA,0))
- IF '$PIECE(^(0),U,2)
- SET DIK=DIE
- DO ^DIK
- End DoDot:1
- IF QUIT
- QUIT
- WRITE !
- +6 QUIT
- +7 ;
- PROTOCOL ; -- Convert additional protocols to dialogs
- +1 NEW X,Y,DIC,ORERR
- +2 FOR
- SET DIC="^ORD(101,"
- SET DIC(0)="AEQM"
- DO ^DIC
- IF Y'>0
- QUIT
- Begin DoDot:1
- +3 ; What about "^^"-jumping? (ORWARD)
- SET ORP=+Y
- SET ORM=$$MENU
- IF ORM="^"
- QUIT
- +4 WRITE !,"Converting ..."
- DO ONE(ORP,ORM,.ORERR)
- IF '$GET(ORERR)
- WRITE " done."
- QUIT
- +5 WRITE " unable to convert.",!,">> "_$PIECE(ORERR,U,2)
- KILL ORERR
- End DoDot:1
- WRITE !
- +6 QUIT
- ONE(PITEM,ORADD,ERROR) ; -- Convert single item protocol, add to menu(s)
- +1 NEW PMENU,DMENU,NAME,ORPOS,POS,XUTL,DA,DIK
- +2 ; delete error entry
- IF $DATA(^ORD(100.99,1,101.41,PITEM,0))
- SET DA=PITEM
- SET DA(1)=1
- SET DIK="^ORD(100.99,1,101.41,"
- DO ^DIK
- +3 SET NAME=$PIECE($GET(^ORD(101,PITEM,0)),U)
- SET DITEM=$$ITEM^ORCONVRT(PITEM)
- +4 IF 'DITEM!$DATA(^ORD(100.99,1,101.41,PITEM,0))
- SET ERROR=$GET(^(0))
- QUIT
- +5 ;to add, may enter here with PITEM & DITEM defined
- IF '$GET(ORADD)
- QUIT
- ADD SET PMENU=0
- FOR
- SET PMENU=$ORDER(^ORD(101,"AD",PITEM,PMENU))
- IF PMENU'>0
- QUIT
- Begin DoDot:1
- +1 SET DMENU=$ORDER(^ORD(101.41,"AB",$PIECE(^ORD(101,PMENU,0),U),0))
- IF 'DMENU
- QUIT
- +2 SET ORPOS=$$FINDXUTL(PMENU,PITEM)
- IF 'ORPOS
- QUIT
- +3 SET XUTL=$GET(^XUTL("XQORM",PMENU_";ORD(101,",ORPOS,0))
- +4 ; move to end, if collision
- SET DA=$ORDER(^ORD(101.41,DMENU,10,"B",ORPOS,0))
- IF DA
- IF $PIECE(^ORD(101.41,DMENU,10,DA,0),U,2)=DITEM
- QUIT
- SET POS=$ORDER(^ORD(101.41,DMENU,10,"B",""),-1)
- SET ORPOS=($PIECE(POS,".")+1)_".1"
- SET DA=""
- +5 SET DA=$$NEXT^ORCONVRT(DMENU)
- +6 SET ^ORD(101.41,DMENU,10,DA,0)=ORPOS_U_DITEM_U_$PIECE(XUTL,U,4)_U_$SELECT($PIECE(XUTL,U,3)'=$PIECE(^ORD(101.41,DITEM,0),U,2):$PIECE(XUTL,U,3),1:"")
- +7 SET ^ORD(101.41,DMENU,10,"B",ORPOS,DA)=""
- SET ^ORD(101.41,DMENU,10,"D",DITEM,DA)=""
- +8 SET ^ORD(101.41,"AD",DITEM,DMENU,DA)=""
- SET ^ORD(101.41,DMENU,99)=$HOROLOG
- End DoDot:1
- WRITE "."
- +9 QUIT
- +10 ;
- FINDXUTL(MENU,ITEM) ; -- Returns position of ITEM in MENU
- +1 NEW XQORM,POS
- +2 SET XQORM=MENU_";ORD(101,"
- DO XREF^XQORM
- +3 SET POS=0
- FOR
- SET POS=$ORDER(^XUTL("XQORM",XQORM,POS))
- IF POS'>0
- QUIT
- IF $PIECE(^(POS,0),U,2)=ITEM
- QUIT
- +4 QUIT POS
- +5 ;
- +1 NEW X,Y,DIR
- SET DIR(0)="YA"
- +2 SET DIR("A")="Add this item to the same menus again? "
- SET DIR("B")="YES"
- +3 SET DIR("?")="Enter YES to have this item placed on the same menus in the Order Dialog file as it was in the Protocol file"
- +4 DO ^DIR
- IF $DATA(DTOUT)
- SET Y="^"
- +5 QUIT Y
- EXPLAIN ;Give reason why user can't set auto-accept to yes
- +1 WRITE !!,"The combination of VERIFY set to NO and ASK FOR ANOTHER ORDER set to",!,"YES, DON'T ASK and AUTO-ACCEPT set to YES is not allowed."
- +2 WRITE !!,"This combination of settings could cause CPRS to enter into an infinite loop",!,"creating the same order over and over. If you wish to have"
- +3 WRITE !,"AUTO-ACCEPT set to YES you must change one of the other two fields",!,"to a different value.",!!,"AUTO-ACCEPT is being set to NO for you."
- +4 QUIT