OREV ;SLC/DAN Event delayed orders set up ;10/25/02 13:46
;;3.0;ORDER ENTRY/RESULTS REPORTING;**142,141**;Dec 17, 1997
;DBIA reference section
;2336 - XPAREDIT, which is used in OREV EVENT input template
;10102- XQORM1
;10104- XLFSTR
;10103- XLFDT
;519 - ^DIC(45.7
;10116- VALM1
;10026- DIR
;10117- VALM10
;10118- VALM
;10006- DIC
;10018- DIE
;10013- DIK
EN ; -- main entry point for OR DELAYED ORDERS
N DIR,Y,ORTYPE,XQORNOD,VALMHDR,VALMSG,VALMBCK,VALMBG,VALMWD,XQORM,ORNMBR
F D Q:+Y'>0 D SWITCH
.S DIR(0)="SO^1:Auto-DC Rules;2:Release Events" D ^DIR K DIR
.Q:+Y'>0 S ORTYPE=$S(Y=1:"A",1:"E")
Q
;
SWITCH D EN^VALM($S(ORTYPE="A":"OREV AUTO-DC ACTIONS",1:"OREV EVENT ACTIONS"))
Q
;
HDR ; -- header code
N LST,DSP
S DSP=$G(^TMP("ORDSP",$J,DUZ))
S LST=$G(^TMP("ORLIST",$J,DUZ))
S VALMHDR(1)=$S(ORTYPE="E":"Event ",1:"Auto-DC ")_"set up and maintenance"
S VALMHDR(1)=VALMHDR(1)_" - "_$S(LST="I":"Inactive",LST="A":"Active",1:"All")_" entries/"_$S(DSP:"Expanded",1:"Truncated")_" view"
Q
;
PHDR ;
S VALMSG=$S($G(ORTYPE)'="":"Select number or enter action desired",1:"")
S XQORM("#")=$S(ORTYPE="E":$O(^ORD(101,"B","OREV ENTER/EDIT EVENTS MENU",0)),1:$O(^ORD(101,"B","OREV ENTER/EDIT AUTO DC MENU",0)))
D SHOW^VALM
Q
;
INIT ;
S VALMBCK="",VALMBG=$S($G(VALMBG)'="":VALMBG,1:1),VALMCNT=0,VALMWD=80
K ^TMP("OREDO",$J),^TMP("ORCXPND",$J)
Q
;
LIST ; -- produce list of existing events/rules
N ORI,ORCNT,ORGLOB,ORJ,NAME,DSP,LST
K ^TMP("OREDO",$J) ;Delete list before building
S DSP=$G(^TMP("ORDSP",$J,DUZ)) ;Display full text if DSP =1 else truncate
S LST=$G(^TMP("ORLIST",$J,DUZ)) ;List shows active, inactive or all
S ORGLOB="^ORD(100."_$S(ORTYPE="E":"5)",1:"6)")
S VALMBCK="R"
S ORI="" F S ORI=$O(@ORGLOB@("B",ORI)) Q:ORI="" D
.S ORJ="" F S ORJ=$O(@ORGLOB@("B",ORI,ORJ)) Q:ORJ="" Q:ORTYPE="E"&($P($G(@ORGLOB@(ORJ,0)),U,12)) D GETENTRY(ORJ,DSP,LST,.ORCNT,ORGLOB)
;set column headers to match display width
S VALMDDF("NAME")="NAME^5^"_$S(DSP:50,1:40)_"^Event Name"
S VALMDDF("DISPTXT")="DISPTXT^"_$S(DSP:58,1:46)_"^"_$S(DSP:60,1:20)_"^Display Text"
S VALMDDF("ACT")="ACT^"_$S(DSP:119,1:67)_"^8^Active?"
S VALMDDF("EVENT")="EVENT^"_$S(DSP:127,1:76)_"^5^Event"
D CHGCAP^VALM("DISPTXT","Display Text") ;Causes caption line to be updated to new values set above
S VALMCNT=+$G(ORCNT)
Q
;
GETENTRY(ENTRY,DSP,LST,ORCNT,ORGLOB) ;
;
N ZNODE,NAME,DN,ACT,ECODE,SP,CHILD,CHENTRY
I LST'="" Q:LST="A"&($G(@ORGLOB@(ENTRY,1))) Q:LST="I"&('$G(@ORGLOB@(ENTRY,1))) ;If not all then only active or inactive
S ZNODE=@ORGLOB@(ENTRY,0)
S CHILD=$S($P(ZNODE,U,12):1,1:0)
S NAME=$P(ZNODE,U) S:'DSP NAME=$E(NAME,1,$S(CHILD:38,1:40)) ;display is truncated
S DN=$S(ORGLOB["5":8,1:5),DN=$P(ZNODE,U,DN) S:'DSP DN=$E(DN,1,20) ;display is truncated
S ACT=$S($P($G(@ORGLOB@(ENTRY,1)),U):"N",1:"Y") ;rule active?
S ECODE=$P(ZNODE,U,2) S:ECODE=""&(CHILD) ECODE=$P(^ORD(100.5,$P(ZNODE,U,12),0),U,2) ;event code
S ORCNT=$G(ORCNT)+1,SP=$$REPEAT^XLFSTR(" ",$S(CHILD:6,1:4)-$L(ORCNT))
D SET^VALM10(ORCNT,ORCNT_SP_NAME_$$REPEAT^XLFSTR(" ",($S(DSP&('CHILD):53,DSP&(CHILD):51,'DSP&('CHILD):41,1:39)-$L(NAME)))_DN_$$REPEAT^XLFSTR(" ",($S(DSP:63,1:23)-$L(DN)))_ACT_" "_ECODE,ENTRY)
I $D(^ORD(100.5,"DAD",ENTRY))&(ORTYPE="E") D
.S CHENTRY=0 F S CHENTRY=$O(^ORD(100.5,"DAD",ENTRY,CHENTRY)) Q:'+CHENTRY D GETENTRY(CHENTRY,DSP,LST,.ORCNT,ORGLOB) ;Recursive call to list children
Q
;
CHKSEL ;Evaluate selection if done by number
N ORJ,ORTMP,DIR,NUM,X,Y
S NUM=$P($G(XQORNOD(0)),"=",2) ;get currently selected entries
I NUM'="" D
.I NUM=$G(ORNMBR) D DESELECT Q ;If user selects same entry without taking an entry, unhighlight and stop processing
.D DESELECT:$G(ORNMBR) ;If user previously selected entries but took no action, unhighlight before highlighting new choices
.S ORNMBR=$P(XQORNOD(0),"=",2),DIR(0)="L^"_"1:"_VALMCNT,X=ORNMBR,DIR("V")="" D ^DIR K DIR
.I Y="" D FULL^VALM1 W !,"Invalid selection." S DIR(0)="E" D ^DIR K ORNMBR,DIR Q ;Selection out of range, stop processing
.F ORJ=1:1:$L(ORNMBR,",")-1 S ORTMP=$P(ORNMBR,",",ORJ) D CNTRL^VALM10(ORTMP,1,+$G(VALMWD),IORVON,IORVOFF)
Q
;
HELP ; -- help code
N X
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("OREDO",$J),^TMP("ORCXPND",$J),^UTILITY("DIQ1",$J),^TMP("ORHIST",$J),^TMP("ORDSP",$J,DUZ),^TMP("ORLIST",$J,DUZ),ORNMBR D FULL^VALM1 Q
;
EEE ;Enter/edit events
N DIC,DLAYGO,ORJ,ORTMP,DA,DIE,DR,ORGLOB,NEW,TYPE,Y,DIDEL
D FULL^VALM1 ;get full screen
S VALMBCK="R"
S ORGLOB=$S(ORTYPE="E":"^ORD(100.5,",1:"^ORD(100.6,")
S DIDEL=$S(ORTYPE="E":100.5,1:100.6)
S DIC=ORGLOB
I $G(ORNMBR)="" S ORNMBR=$$ORDERS^OREV1("edit") Q:ORNMBR="^" ;If action selected before items, get items
I $G(ORNMBR)="" D Q
.S DLAYGO=$S(ORTYPE="E":100.5,1:100.6),DIC(0)="AEMQL"
.D ^DIC Q:Y=-1 S NEW=$S($L(Y,"^")=3:1,1:0),DIE=DIC,DA=+Y
.L +@(ORGLOB_DA_")"):1 I '$T W !!,"This entry is being edited by another user." H 3 Q
.I NEW D COPY(DA) S DR="1///"_$$NOW^XLFDT D ^DIE W !!,"NOTE: New entries start INACTIVATED.",! ;New entries start inactivated
.I 'NEW S TYPE=$P(@(ORGLOB_DA_",0)"),U,2)
.I ORTYPE="E" I $$RELEVNTS^OREV1(DA) W !!,$C(7),"** This event has delayed orders associated with it! **",!,"Editing will affect these delayed events.",!
.I ORTYPE="A" W !!,"Editing auto-dc rules takes effect immediately.",!
.S DR="[OREV "_$S(ORTYPE="E"&($P($G(^ORD(100.5,DA,0)),U,12)):"CHILD EVENT",ORTYPE="E":"EVENT",1:"AUTO DC") D ^DIE
.I $G(DA) I 'NEW I $G(TYPE)'=$P(@(ORGLOB_DA_",0)"),U,2) D CHKTYP^OREV1(DA) ;If new event and type changed then check event type for extraneous entries
.I $G(DA) I 'NEW I TYPE="T",ORTYPE="A",'$D(^ORD(100.6,DA,3,"B",4)) D DELMUL^OREV1(100.6,DA,5),DELMUL^OREV1(100.6,DA,6) ;If not new entry and type is transfer and MAS MOVEMENT TYPE is not interward transfer then delete locations and divisions
.I $G(DA) D AUDIT(DA,$S($G(NEW):"N",1:"E")) ;If entry not deleted add to audit history
.I $G(DA) L -@(ORGLOB_DA_")")
;
F ORJ=1:1:$L(ORNMBR,",")-1 S ORTMP=$P(ORNMBR,",",ORJ),DA=$O(^TMP("OREDO",$J,"IDX",ORTMP,0)) D
.W ! W:ORJ'=1 !,"**NOW EDITING NEXT ENTRY**",!
.L +@(ORGLOB_DA_")"):1 I '$T W !!,"This entry is being edited by another user." H 3 Q ;Lock global
.I ORTYPE="E" I $$RELEVNTS^OREV1(DA) W !!,$C(7),"** This event has delayed orders associated with it! **",!,"Editing will affect these delayed events.",!
.I ORTYPE="A" W !!,"Editing auto-dc rules takes effect immediately.",!
.S TYPE=$P(@(ORGLOB_DA_",0)"),U,2)
.S DIE=DIC,DR="[OREV "_$S(ORTYPE="E"&($P($G(^ORD(100.5,DA,0)),U,12)):"CHILD EVENT",ORTYPE="E":"EVENT",1:"AUTO DC") D ^DIE
.I $G(DA) I $G(TYPE)'=$P(@(ORGLOB_DA_",0)"),U,2) D CHKTYP^OREV1(DA) ;If entry not deleted check event type and add to audit history
.I $G(DA) I TYPE="T",ORTYPE="A",'$D(^ORD(100.6,DA,3,"B",4)) D DELMUL^OREV1(100.6,DA,5),DELMUL^OREV1(100.6,DA,6) ;If not new entry and type is transfer and MAS MOVEMENT TYPE is not interward transfer then delete locations and divisions
.I $G(DA) D AUDIT(DA,"E") ;If entry not deleted add to audit history
.I $G(DA) L -@(ORGLOB_DA_")") ;Unlock global
K DIE("NO^") Q
;
DESELECT ;Un-highlight selected choices
N ORJ,ORTMP
F ORJ=1:1:$L($G(ORNMBR),",")-1 S ORTMP=$P(ORNMBR,",",ORJ) D CNTRL^VALM10(ORTMP,1,+$G(VALMWD),IORVOFF,IORVOFF)
K ORNMBR
Q
;
COPY(NEWENT) ;Allow new entries to copy from existing entries
N DIR,DLAYGO,DIC,DA,DIK,DIE,NAME,DIVISN,DR,Y
S DIR(0)="Y",DIR("A")="Do you want to copy from an existing entry",DIR("B")="NO",DIR("?")="Enter Yes to copy an existing entry to this one" D ^DIR Q:Y'=1
S DIC(0)="AEMQ",DIC=ORGLOB,DIC("S")="I Y'=NEWENT,$P(@(ORGLOB_+Y_"",0)""),U,2)=$P(@(ORGLOB_NEWENT_"",0)""),U,2)" D ^DIC Q:Y=-1 ;Quit if no selection made
W !,"Copying..."
S NAME=$P(@(ORGLOB_NEWENT_",0)"),U) ;get name of new entry
S DIVISN=$P(@(ORGLOB_NEWENT_",0)"),U,3) ;get division of new entry
M @(ORGLOB_NEWENT_")")=@(ORGLOB_+Y_")")
K @(ORGLOB_NEWENT_",2)") ;Delete activation history that was copied
K @(ORGLOB_NEWENT_",9)") ;Delete audit history that was copied.
S DIK=DIC,DA=+Y D IX1^DIK ;set all xrefs for new entry
S DIE=ORGLOB,DA=NEWENT,DR=".01///"_NAME_";3///"_DIVISN D ^DIE ;reset name and division of new entry
Q
;
AUDIT(ENTRY,TYPE) ;Adds audit history for entry
N DIC,DA,DIE,X,Y,DR
S DA(1)=ENTRY,DIC(0)="L",X=$$NOW^XLFDT,DIC=ORGLOB_DA(1)_",9,"
D ^DIC Q:Y=-1 ;Stop processing if entry not added
S DIE=DIC K DIC
S DA=+Y
S DR="1///"_$S($G(DUZ):"`"_DUZ,1:"")_";2///"_TYPE D ^DIE
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOREV 8597 printed Apr 09, 2024@21:41:21 Page 2
OREV ;SLC/DAN Event delayed orders set up ;10/25/02 13:46
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**142,141**;Dec 17, 1997
+2 ;DBIA reference section
+3 ;2336 - XPAREDIT, which is used in OREV EVENT input template
+4 ;10102- XQORM1
+5 ;10104- XLFSTR
+6 ;10103- XLFDT
+7 ;519 - ^DIC(45.7
+8 ;10116- VALM1
+9 ;10026- DIR
+10 ;10117- VALM10
+11 ;10118- VALM
+12 ;10006- DIC
+13 ;10018- DIE
+14 ;10013- DIK
EN ; -- main entry point for OR DELAYED ORDERS
+1 NEW DIR,Y,ORTYPE,XQORNOD,VALMHDR,VALMSG,VALMBCK,VALMBG,VALMWD,XQORM,ORNMBR
+2 FOR
Begin DoDot:1
+3 SET DIR(0)="SO^1:Auto-DC Rules;2:Release Events"
DO ^DIR
KILL DIR
+4 if +Y'>0
QUIT
SET ORTYPE=$SELECT(Y=1:"A",1:"E")
End DoDot:1
if +Y'>0
QUIT
DO SWITCH
+5 QUIT
+6 ;
SWITCH DO EN^VALM($SELECT(ORTYPE="A":"OREV AUTO-DC ACTIONS",1:"OREV EVENT ACTIONS"))
+1 QUIT
+2 ;
HDR ; -- header code
+1 NEW LST,DSP
+2 SET DSP=$GET(^TMP("ORDSP",$JOB,DUZ))
+3 SET LST=$GET(^TMP("ORLIST",$JOB,DUZ))
+4 SET VALMHDR(1)=$SELECT(ORTYPE="E":"Event ",1:"Auto-DC ")_"set up and maintenance"
+5 SET VALMHDR(1)=VALMHDR(1)_" - "_$SELECT(LST="I":"Inactive",LST="A":"Active",1:"All")_" entries/"_$SELECT(DSP:"Expanded",1:"Truncated")_" view"
+6 QUIT
+7 ;
PHDR ;
+1 SET VALMSG=$SELECT($GET(ORTYPE)'="":"Select number or enter action desired",1:"")
+2 SET XQORM("#")=$SELECT(ORTYPE="E":$ORDER(^ORD(101,"B","OREV ENTER/EDIT EVENTS MENU",0)),1:$ORDER(^ORD(101,"B","OREV ENTER/EDIT AUTO DC MENU",0)))
+3 DO SHOW^VALM
+4 QUIT
+5 ;
INIT ;
+1 SET VALMBCK=""
SET VALMBG=$SELECT($GET(VALMBG)'="":VALMBG,1:1)
SET VALMCNT=0
SET VALMWD=80
+2 KILL ^TMP("OREDO",$JOB),^TMP("ORCXPND",$JOB)
+3 QUIT
+4 ;
LIST ; -- produce list of existing events/rules
+1 NEW ORI,ORCNT,ORGLOB,ORJ,NAME,DSP,LST
+2 ;Delete list before building
KILL ^TMP("OREDO",$JOB)
+3 ;Display full text if DSP =1 else truncate
SET DSP=$GET(^TMP("ORDSP",$JOB,DUZ))
+4 ;List shows active, inactive or all
SET LST=$GET(^TMP("ORLIST",$JOB,DUZ))
+5 SET ORGLOB="^ORD(100."_$SELECT(ORTYPE="E":"5)",1:"6)")
+6 SET VALMBCK="R"
+7 SET ORI=""
FOR
SET ORI=$ORDER(@ORGLOB@("B",ORI))
if ORI=""
QUIT
Begin DoDot:1
+8 SET ORJ=""
FOR
SET ORJ=$ORDER(@ORGLOB@("B",ORI,ORJ))
if ORJ=""
QUIT
if ORTYPE="E"&($PIECE($GET(@ORGLOB@(ORJ,0)),U,12))
QUIT
DO GETENTRY(ORJ,DSP,LST,.ORCNT,ORGLOB)
End DoDot:1
+9 ;set column headers to match display width
+10 SET VALMDDF("NAME")="NAME^5^"_$SELECT(DSP:50,1:40)_"^Event Name"
+11 SET VALMDDF("DISPTXT")="DISPTXT^"_$SELECT(DSP:58,1:46)_"^"_$SELECT(DSP:60,1:20)_"^Display Text"
+12 SET VALMDDF("ACT")="ACT^"_$SELECT(DSP:119,1:67)_"^8^Active?"
+13 SET VALMDDF("EVENT")="EVENT^"_$SELECT(DSP:127,1:76)_"^5^Event"
+14 ;Causes caption line to be updated to new values set above
DO CHGCAP^VALM("DISPTXT","Display Text")
+15 SET VALMCNT=+$GET(ORCNT)
+16 QUIT
+17 ;
GETENTRY(ENTRY,DSP,LST,ORCNT,ORGLOB) ;
+1 ;
+2 NEW ZNODE,NAME,DN,ACT,ECODE,SP,CHILD,CHENTRY
+3 ;If not all then only active or inactive
IF LST'=""
if LST="A"&($GET(@ORGLOB@(ENTRY,1)))
QUIT
if LST="I"&('$GET(@ORGLOB@(ENTRY,1)))
QUIT
+4 SET ZNODE=@ORGLOB@(ENTRY,0)
+5 SET CHILD=$SELECT($PIECE(ZNODE,U,12):1,1:0)
+6 ;display is truncated
SET NAME=$PIECE(ZNODE,U)
if 'DSP
SET NAME=$EXTRACT(NAME,1,$SELECT(CHILD:38,1:40))
+7 ;display is truncated
SET DN=$SELECT(ORGLOB["5":8,1:5)
SET DN=$PIECE(ZNODE,U,DN)
if 'DSP
SET DN=$EXTRACT(DN,1,20)
+8 ;rule active?
SET ACT=$SELECT($PIECE($GET(@ORGLOB@(ENTRY,1)),U):"N",1:"Y")
+9 ;event code
SET ECODE=$PIECE(ZNODE,U,2)
if ECODE=""&(CHILD)
SET ECODE=$PIECE(^ORD(100.5,$PIECE(ZNODE,U,12),0),U,2)
+10 SET ORCNT=$GET(ORCNT)+1
SET SP=$$REPEAT^XLFSTR(" ",$SELECT(CHILD:6,1:4)-$LENGTH(ORCNT))
+11 DO SET^VALM10(ORCNT,ORCNT_SP_NAME_$$REPEAT^XLFSTR(" ",($SELECT(DSP&('CHILD):53,DSP&(CHILD):51,'DSP&('CHILD):41,1:39)-$LENGTH(NAME)))_DN_$$REPEAT^XLFSTR(" ",($SELECT(DSP:63,1:23)-$LENGTH(DN)))_ACT_" "_ECODE,ENTRY)
+12 IF $DATA(^ORD(100.5,"DAD",ENTRY))&(ORTYPE="E")
Begin DoDot:1
+13 ;Recursive call to list children
SET CHENTRY=0
FOR
SET CHENTRY=$ORDER(^ORD(100.5,"DAD",ENTRY,CHENTRY))
if '+CHENTRY
QUIT
DO GETENTRY(CHENTRY,DSP,LST,.ORCNT,ORGLOB)
End DoDot:1
+14 QUIT
+15 ;
CHKSEL ;Evaluate selection if done by number
+1 NEW ORJ,ORTMP,DIR,NUM,X,Y
+2 ;get currently selected entries
SET NUM=$PIECE($GET(XQORNOD(0)),"=",2)
+3 IF NUM'=""
Begin DoDot:1
+4 ;If user selects same entry without taking an entry, unhighlight and stop processing
IF NUM=$GET(ORNMBR)
DO DESELECT
QUIT
+5 ;If user previously selected entries but took no action, unhighlight before highlighting new choices
if $GET(ORNMBR)
DO DESELECT
+6 SET ORNMBR=$PIECE(XQORNOD(0),"=",2)
SET DIR(0)="L^"_"1:"_VALMCNT
SET X=ORNMBR
SET DIR("V")=""
DO ^DIR
KILL DIR
+7 ;Selection out of range, stop processing
IF Y=""
DO FULL^VALM1
WRITE !,"Invalid selection."
SET DIR(0)="E"
DO ^DIR
KILL ORNMBR,DIR
QUIT
+8 FOR ORJ=1:1:$LENGTH(ORNMBR,",")-1
SET ORTMP=$PIECE(ORNMBR,",",ORJ)
DO CNTRL^VALM10(ORTMP,1,+$GET(VALMWD),IORVON,IORVOFF)
End DoDot:1
+9 QUIT
+10 ;
HELP ; -- help code
+1 NEW X
+2 SET X="?"
DO DISP^XQORM1
WRITE !!
+3 QUIT
+4 ;
EXIT ; -- exit code
+1 KILL ^TMP("OREDO",$JOB),^TMP("ORCXPND",$JOB),^UTILITY("DIQ1",$JOB),^TMP("ORHIST",$JOB),^TMP("ORDSP",$JOB,DUZ),^TMP("ORLIST",$JOB,DUZ),ORNMBR
DO FULL^VALM1
QUIT
+2 ;
EEE ;Enter/edit events
+1 NEW DIC,DLAYGO,ORJ,ORTMP,DA,DIE,DR,ORGLOB,NEW,TYPE,Y,DIDEL
+2 ;get full screen
DO FULL^VALM1
+3 SET VALMBCK="R"
+4 SET ORGLOB=$SELECT(ORTYPE="E":"^ORD(100.5,",1:"^ORD(100.6,")
+5 SET DIDEL=$SELECT(ORTYPE="E":100.5,1:100.6)
+6 SET DIC=ORGLOB
+7 ;If action selected before items, get items
IF $GET(ORNMBR)=""
SET ORNMBR=$$ORDERS^OREV1("edit")
if ORNMBR="^"
QUIT
+8 IF $GET(ORNMBR)=""
Begin DoDot:1
+9 SET DLAYGO=$SELECT(ORTYPE="E":100.5,1:100.6)
SET DIC(0)="AEMQL"
+10 DO ^DIC
if Y=-1
QUIT
SET NEW=$SELECT($LENGTH(Y,"^")=3:1,1:0)
SET DIE=DIC
SET DA=+Y
+11 LOCK +@(ORGLOB_DA_")"):1
IF '$TEST
WRITE !!,"This entry is being edited by another user."
HANG 3
QUIT
+12 ;New entries start inactivated
IF NEW
DO COPY(DA)
SET DR="1///"_$$NOW^XLFDT
DO ^DIE
WRITE !!,"NOTE: New entries start INACTIVATED.",!
+13 IF 'NEW
SET TYPE=$PIECE(@(ORGLOB_DA_",0)"),U,2)
+14 IF ORTYPE="E"
IF $$RELEVNTS^OREV1(DA)
WRITE !!,$CHAR(7),"** This event has delayed orders associated with it! **",!,"Editing will affect these delayed events.",!
+15 IF ORTYPE="A"
WRITE !!,"Editing auto-dc rules takes effect immediately.",!
+16 SET DR="[OREV "_$SELECT(ORTYPE="E"&($PIECE($GET(^ORD(100.5,DA,0)),U,12)):"CHILD EVENT",ORTYPE="E":"EVENT",1:"AUTO DC")
DO ^DIE
+17 ;If new event and type changed then check event type for extraneous entries
IF $GET(DA)
IF 'NEW
IF $GET(TYPE)'=$PIECE(@(ORGLOB_DA_",0)"),U,2)
DO CHKTYP^OREV1(DA)
+18 ;If not new entry and type is transfer and MAS MOVEMENT TYPE is not interward transfer then delete locations and divisions
IF $GET(DA)
IF 'NEW
IF TYPE="T"
IF ORTYPE="A"
IF '$DATA(^ORD(100.6,DA,3,"B",4))
DO DELMUL^OREV1(100.6,DA,5)
DO DELMUL^OREV1(100.6,DA,6)
+19 ;If entry not deleted add to audit history
IF $GET(DA)
DO AUDIT(DA,$SELECT($GET(NEW):"N",1:"E"))
+20 IF $GET(DA)
LOCK -@(ORGLOB_DA_")")
End DoDot:1
QUIT
+21 ;
+22 FOR ORJ=1:1:$LENGTH(ORNMBR,",")-1
SET ORTMP=$PIECE(ORNMBR,",",ORJ)
SET DA=$ORDER(^TMP("OREDO",$JOB,"IDX",ORTMP,0))
Begin DoDot:1
+23 WRITE !
if ORJ'=1
WRITE !,"**NOW EDITING NEXT ENTRY**",!
+24 ;Lock global
LOCK +@(ORGLOB_DA_")"):1
IF '$TEST
WRITE !!,"This entry is being edited by another user."
HANG 3
QUIT
+25 IF ORTYPE="E"
IF $$RELEVNTS^OREV1(DA)
WRITE !!,$CHAR(7),"** This event has delayed orders associated with it! **",!,"Editing will affect these delayed events.",!
+26 IF ORTYPE="A"
WRITE !!,"Editing auto-dc rules takes effect immediately.",!
+27 SET TYPE=$PIECE(@(ORGLOB_DA_",0)"),U,2)
+28 SET DIE=DIC
SET DR="[OREV "_$SELECT(ORTYPE="E"&($PIECE($GET(^ORD(100.5,DA,0)),U,12)):"CHILD EVENT",ORTYPE="E":"EVENT",1:"AUTO DC")
DO ^DIE
+29 ;If entry not deleted check event type and add to audit history
IF $GET(DA)
IF $GET(TYPE)'=$PIECE(@(ORGLOB_DA_",0)"),U,2)
DO CHKTYP^OREV1(DA)
+30 ;If not new entry and type is transfer and MAS MOVEMENT TYPE is not interward transfer then delete locations and divisions
IF $GET(DA)
IF TYPE="T"
IF ORTYPE="A"
IF '$DATA(^ORD(100.6,DA,3,"B",4))
DO DELMUL^OREV1(100.6,DA,5)
DO DELMUL^OREV1(100.6,DA,6)
+31 ;If entry not deleted add to audit history
IF $GET(DA)
DO AUDIT(DA,"E")
+32 ;Unlock global
IF $GET(DA)
LOCK -@(ORGLOB_DA_")")
End DoDot:1
+33 KILL DIE("NO^")
QUIT
+34 ;
DESELECT ;Un-highlight selected choices
+1 NEW ORJ,ORTMP
+2 FOR ORJ=1:1:$LENGTH($GET(ORNMBR),",")-1
SET ORTMP=$PIECE(ORNMBR,",",ORJ)
DO CNTRL^VALM10(ORTMP,1,+$GET(VALMWD),IORVOFF,IORVOFF)
+3 KILL ORNMBR
+4 QUIT
+5 ;
COPY(NEWENT) ;Allow new entries to copy from existing entries
+1 NEW DIR,DLAYGO,DIC,DA,DIK,DIE,NAME,DIVISN,DR,Y
+2 SET DIR(0)="Y"
SET DIR("A")="Do you want to copy from an existing entry"
SET DIR("B")="NO"
SET DIR("?")="Enter Yes to copy an existing entry to this one"
DO ^DIR
if Y'=1
QUIT
+3 ;Quit if no selection made
SET DIC(0)="AEMQ"
SET DIC=ORGLOB
SET DIC("S")="I Y'=NEWENT,$P(@(ORGLOB_+Y_"",0)""),U,2)=$P(@(ORGLOB_NEWENT_"",0)""),U,2)"
DO ^DIC
if Y=-1
QUIT
+4 WRITE !,"Copying..."
+5 ;get name of new entry
SET NAME=$PIECE(@(ORGLOB_NEWENT_",0)"),U)
+6 ;get division of new entry
SET DIVISN=$PIECE(@(ORGLOB_NEWENT_",0)"),U,3)
+7 MERGE @(ORGLOB_NEWENT_")")=@(ORGLOB_+Y_")")
+8 ;Delete activation history that was copied
KILL @(ORGLOB_NEWENT_",2)")
+9 ;Delete audit history that was copied.
KILL @(ORGLOB_NEWENT_",9)")
+10 ;set all xrefs for new entry
SET DIK=DIC
SET DA=+Y
DO IX1^DIK
+11 ;reset name and division of new entry
SET DIE=ORGLOB
SET DA=NEWENT
SET DR=".01///"_NAME_";3///"_DIVISN
DO ^DIE
+12 QUIT
+13 ;
AUDIT(ENTRY,TYPE) ;Adds audit history for entry
+1 NEW DIC,DA,DIE,X,Y,DR
+2 SET DA(1)=ENTRY
SET DIC(0)="L"
SET X=$$NOW^XLFDT
SET DIC=ORGLOB_DA(1)_",9,"
+3 ;Stop processing if entry not added
DO ^DIC
if Y=-1
QUIT
+4 SET DIE=DIC
KILL DIC
+5 SET DA=+Y
+6 SET DR="1///"_$SELECT($GET(DUZ):"`"_DUZ,1:"")_";2///"_TYPE
DO ^DIE
+7 QUIT
+8 ;
