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