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

OREV.m

Go to the documentation of this file.
  1. 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
  1. ;DBIA reference section
  1. ;2336 - XPAREDIT, which is used in OREV EVENT input template
  1. ;10102- XQORM1
  1. ;10104- XLFSTR
  1. ;10103- XLFDT
  1. ;519 - ^DIC(45.7
  1. ;10116- VALM1
  1. ;10026- DIR
  1. ;10117- VALM10
  1. ;10118- VALM
  1. ;10006- DIC
  1. ;10018- DIE
  1. ;10013- DIK
  1. EN ; -- main entry point for OR DELAYED ORDERS
  1. N DIR,Y,ORTYPE,XQORNOD,VALMHDR,VALMSG,VALMBCK,VALMBG,VALMWD,XQORM,ORNMBR
  1. F D Q:+Y'>0 D SWITCH
  1. .S DIR(0)="SO^1:Auto-DC Rules;2:Release Events" D ^DIR K DIR
  1. .Q:+Y'>0 S ORTYPE=$S(Y=1:"A",1:"E")
  1. Q
  1. ;
  1. SWITCH D EN^VALM($S(ORTYPE="A":"OREV AUTO-DC ACTIONS",1:"OREV EVENT ACTIONS"))
  1. Q
  1. ;
  1. HDR ; -- header code
  1. N LST,DSP
  1. S DSP=$G(^TMP("ORDSP",$J,DUZ))
  1. S LST=$G(^TMP("ORLIST",$J,DUZ))
  1. S VALMHDR(1)=$S(ORTYPE="E":"Event ",1:"Auto-DC ")_"set up and maintenance"
  1. S VALMHDR(1)=VALMHDR(1)_" - "_$S(LST="I":"Inactive",LST="A":"Active",1:"All")_" entries/"_$S(DSP:"Expanded",1:"Truncated")_" view"
  1. Q
  1. ;
  1. PHDR ;
  1. S VALMSG=$S($G(ORTYPE)'="":"Select number or enter action desired",1:"")
  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)))
  1. D SHOW^VALM
  1. Q
  1. ;
  1. INIT ;
  1. S VALMBCK="",VALMBG=$S($G(VALMBG)'="":VALMBG,1:1),VALMCNT=0,VALMWD=80
  1. K ^TMP("OREDO",$J),^TMP("ORCXPND",$J)
  1. Q
  1. ;
  1. LIST ; -- produce list of existing events/rules
  1. N ORI,ORCNT,ORGLOB,ORJ,NAME,DSP,LST
  1. K ^TMP("OREDO",$J) ;Delete list before building
  1. S DSP=$G(^TMP("ORDSP",$J,DUZ)) ;Display full text if DSP =1 else truncate
  1. S LST=$G(^TMP("ORLIST",$J,DUZ)) ;List shows active, inactive or all
  1. S ORGLOB="^ORD(100."_$S(ORTYPE="E":"5)",1:"6)")
  1. S VALMBCK="R"
  1. S ORI="" F S ORI=$O(@ORGLOB@("B",ORI)) Q:ORI="" D
  1. .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)
  1. ;set column headers to match display width
  1. S VALMDDF("NAME")="NAME^5^"_$S(DSP:50,1:40)_"^Event Name"
  1. S VALMDDF("DISPTXT")="DISPTXT^"_$S(DSP:58,1:46)_"^"_$S(DSP:60,1:20)_"^Display Text"
  1. S VALMDDF("ACT")="ACT^"_$S(DSP:119,1:67)_"^8^Active?"
  1. S VALMDDF("EVENT")="EVENT^"_$S(DSP:127,1:76)_"^5^Event"
  1. D CHGCAP^VALM("DISPTXT","Display Text") ;Causes caption line to be updated to new values set above
  1. S VALMCNT=+$G(ORCNT)
  1. Q
  1. ;
  1. GETENTRY(ENTRY,DSP,LST,ORCNT,ORGLOB) ;
  1. ;
  1. N ZNODE,NAME,DN,ACT,ECODE,SP,CHILD,CHENTRY
  1. I LST'="" Q:LST="A"&($G(@ORGLOB@(ENTRY,1))) Q:LST="I"&('$G(@ORGLOB@(ENTRY,1))) ;If not all then only active or inactive
  1. S ZNODE=@ORGLOB@(ENTRY,0)
  1. S CHILD=$S($P(ZNODE,U,12):1,1:0)
  1. S NAME=$P(ZNODE,U) S:'DSP NAME=$E(NAME,1,$S(CHILD:38,1:40)) ;display is truncated
  1. S DN=$S(ORGLOB["5":8,1:5),DN=$P(ZNODE,U,DN) S:'DSP DN=$E(DN,1,20) ;display is truncated
  1. S ACT=$S($P($G(@ORGLOB@(ENTRY,1)),U):"N",1:"Y") ;rule active?
  1. S ECODE=$P(ZNODE,U,2) S:ECODE=""&(CHILD) ECODE=$P(^ORD(100.5,$P(ZNODE,U,12),0),U,2) ;event code
  1. S ORCNT=$G(ORCNT)+1,SP=$$REPEAT^XLFSTR(" ",$S(CHILD:6,1:4)-$L(ORCNT))
  1. 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)
  1. I $D(^ORD(100.5,"DAD",ENTRY))&(ORTYPE="E") D
  1. .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
  1. Q
  1. ;
  1. CHKSEL ;Evaluate selection if done by number
  1. N ORJ,ORTMP,DIR,NUM,X,Y
  1. S NUM=$P($G(XQORNOD(0)),"=",2) ;get currently selected entries
  1. I NUM'="" D
  1. .I NUM=$G(ORNMBR) D DESELECT Q ;If user selects same entry without taking an entry, unhighlight and stop processing
  1. .D DESELECT:$G(ORNMBR) ;If user previously selected entries but took no action, unhighlight before highlighting new choices
  1. .S ORNMBR=$P(XQORNOD(0),"=",2),DIR(0)="L^"_"1:"_VALMCNT,X=ORNMBR,DIR("V")="" D ^DIR K DIR
  1. .I Y="" D FULL^VALM1 W !,"Invalid selection." S DIR(0)="E" D ^DIR K ORNMBR,DIR Q ;Selection out of range, stop processing
  1. .F ORJ=1:1:$L(ORNMBR,",")-1 S ORTMP=$P(ORNMBR,",",ORJ) D CNTRL^VALM10(ORTMP,1,+$G(VALMWD),IORVON,IORVOFF)
  1. Q
  1. ;
  1. HELP ; -- help code
  1. N X
  1. S X="?" D DISP^XQORM1 W !!
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. 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
  1. ;
  1. EEE ;Enter/edit events
  1. N DIC,DLAYGO,ORJ,ORTMP,DA,DIE,DR,ORGLOB,NEW,TYPE,Y,DIDEL
  1. D FULL^VALM1 ;get full screen
  1. S VALMBCK="R"
  1. S ORGLOB=$S(ORTYPE="E":"^ORD(100.5,",1:"^ORD(100.6,")
  1. S DIDEL=$S(ORTYPE="E":100.5,1:100.6)
  1. S DIC=ORGLOB
  1. I $G(ORNMBR)="" S ORNMBR=$$ORDERS^OREV1("edit") Q:ORNMBR="^" ;If action selected before items, get items
  1. I $G(ORNMBR)="" D Q
  1. .S DLAYGO=$S(ORTYPE="E":100.5,1:100.6),DIC(0)="AEMQL"
  1. .D ^DIC Q:Y=-1 S NEW=$S($L(Y,"^")=3:1,1:0),DIE=DIC,DA=+Y
  1. .L +@(ORGLOB_DA_")"):1 I '$T W !!,"This entry is being edited by another user." H 3 Q
  1. .I NEW D COPY(DA) S DR="1///"_$$NOW^XLFDT D ^DIE W !!,"NOTE: New entries start INACTIVATED.",! ;New entries start inactivated
  1. .I 'NEW S TYPE=$P(@(ORGLOB_DA_",0)"),U,2)
  1. .I ORTYPE="E" I $$RELEVNTS^OREV1(DA) W !!,$C(7),"** This event has delayed orders associated with it! **",!,"Editing will affect these delayed events.",!
  1. .I ORTYPE="A" W !!,"Editing auto-dc rules takes effect immediately.",!
  1. .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
  1. .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
  1. .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
  1. .I $G(DA) D AUDIT(DA,$S($G(NEW):"N",1:"E")) ;If entry not deleted add to audit history
  1. .I $G(DA) L -@(ORGLOB_DA_")")
  1. ;
  1. F ORJ=1:1:$L(ORNMBR,",")-1 S ORTMP=$P(ORNMBR,",",ORJ),DA=$O(^TMP("OREDO",$J,"IDX",ORTMP,0)) D
  1. .W ! W:ORJ'=1 !,"**NOW EDITING NEXT ENTRY**",!
  1. .L +@(ORGLOB_DA_")"):1 I '$T W !!,"This entry is being edited by another user." H 3 Q ;Lock global
  1. .I ORTYPE="E" I $$RELEVNTS^OREV1(DA) W !!,$C(7),"** This event has delayed orders associated with it! **",!,"Editing will affect these delayed events.",!
  1. .I ORTYPE="A" W !!,"Editing auto-dc rules takes effect immediately.",!
  1. .S TYPE=$P(@(ORGLOB_DA_",0)"),U,2)
  1. .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
  1. .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
  1. .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
  1. .I $G(DA) D AUDIT(DA,"E") ;If entry not deleted add to audit history
  1. .I $G(DA) L -@(ORGLOB_DA_")") ;Unlock global
  1. K DIE("NO^") Q
  1. ;
  1. DESELECT ;Un-highlight selected choices
  1. N ORJ,ORTMP
  1. F ORJ=1:1:$L($G(ORNMBR),",")-1 S ORTMP=$P(ORNMBR,",",ORJ) D CNTRL^VALM10(ORTMP,1,+$G(VALMWD),IORVOFF,IORVOFF)
  1. K ORNMBR
  1. Q
  1. ;
  1. COPY(NEWENT) ;Allow new entries to copy from existing entries
  1. N DIR,DLAYGO,DIC,DA,DIK,DIE,NAME,DIVISN,DR,Y
  1. 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
  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
  1. W !,"Copying..."
  1. S NAME=$P(@(ORGLOB_NEWENT_",0)"),U) ;get name of new entry
  1. S DIVISN=$P(@(ORGLOB_NEWENT_",0)"),U,3) ;get division of new entry
  1. M @(ORGLOB_NEWENT_")")=@(ORGLOB_+Y_")")
  1. K @(ORGLOB_NEWENT_",2)") ;Delete activation history that was copied
  1. K @(ORGLOB_NEWENT_",9)") ;Delete audit history that was copied.
  1. S DIK=DIC,DA=+Y D IX1^DIK ;set all xrefs for new entry
  1. S DIE=ORGLOB,DA=NEWENT,DR=".01///"_NAME_";3///"_DIVISN D ^DIE ;reset name and division of new entry
  1. Q
  1. ;
  1. AUDIT(ENTRY,TYPE) ;Adds audit history for entry
  1. N DIC,DA,DIE,X,Y,DR
  1. S DA(1)=ENTRY,DIC(0)="L",X=$$NOW^XLFDT,DIC=ORGLOB_DA(1)_",9,"
  1. D ^DIC Q:Y=-1 ;Stop processing if entry not added
  1. S DIE=DIC K DIC
  1. S DA=+Y
  1. S DR="1///"_$S($G(DUZ):"`"_DUZ,1:"")_";2///"_TYPE D ^DIE
  1. Q
  1. ;