source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OREV.m

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
 ;