source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OREV.m@ 1452

Last change on this file since 1452 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 8.2 KB
Line 
1OREV ;SLC/DAN Event delayed orders set up ;10/25/02 13:46
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**142,141**;Dec 17, 1997
3 ;DBIA reference section
4 ;2336 - XPAREDIT, which is used in OREV EVENT input template
5 ;10102- XQORM1
6 ;10104- XLFSTR
7 ;10103- XLFDT
8 ;519 - ^DIC(45.7
9 ;10116- VALM1
10 ;10026- DIR
11 ;10117- VALM10
12 ;10118- VALM
13 ;10006- DIC
14 ;10018- DIE
15 ;10013- DIK
16EN ; -- main entry point for OR DELAYED ORDERS
17 N DIR,Y,ORTYPE,XQORNOD,VALMHDR,VALMSG,VALMBCK,VALMBG,VALMWD,XQORM,ORNMBR
18 F D Q:+Y'>0 D SWITCH
19 .S DIR(0)="SO^1:Auto-DC Rules;2:Release Events" D ^DIR K DIR
20 .Q:+Y'>0 S ORTYPE=$S(Y=1:"A",1:"E")
21 Q
22 ;
23SWITCH D EN^VALM($S(ORTYPE="A":"OREV AUTO-DC ACTIONS",1:"OREV EVENT ACTIONS"))
24 Q
25 ;
26HDR ; -- header code
27 N LST,DSP
28 S DSP=$G(^TMP("ORDSP",$J,DUZ))
29 S LST=$G(^TMP("ORLIST",$J,DUZ))
30 S VALMHDR(1)=$S(ORTYPE="E":"Event ",1:"Auto-DC ")_"set up and maintenance"
31 S VALMHDR(1)=VALMHDR(1)_" - "_$S(LST="I":"Inactive",LST="A":"Active",1:"All")_" entries/"_$S(DSP:"Expanded",1:"Truncated")_" view"
32 Q
33 ;
34PHDR ;
35 S VALMSG=$S($G(ORTYPE)'="":"Select number or enter action desired",1:"")
36 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)))
37 D SHOW^VALM
38 Q
39 ;
40INIT ;
41 S VALMBCK="",VALMBG=$S($G(VALMBG)'="":VALMBG,1:1),VALMCNT=0,VALMWD=80
42 K ^TMP("OREDO",$J),^TMP("ORCXPND",$J)
43 Q
44 ;
45LIST ; -- produce list of existing events/rules
46 N ORI,ORCNT,ORGLOB,ORJ,NAME,DSP,LST
47 K ^TMP("OREDO",$J) ;Delete list before building
48 S DSP=$G(^TMP("ORDSP",$J,DUZ)) ;Display full text if DSP =1 else truncate
49 S LST=$G(^TMP("ORLIST",$J,DUZ)) ;List shows active, inactive or all
50 S ORGLOB="^ORD(100."_$S(ORTYPE="E":"5)",1:"6)")
51 S VALMBCK="R"
52 S ORI="" F S ORI=$O(@ORGLOB@("B",ORI)) Q:ORI="" D
53 .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)
54 ;set column headers to match display width
55 S VALMDDF("NAME")="NAME^5^"_$S(DSP:50,1:40)_"^Event Name"
56 S VALMDDF("DISPTXT")="DISPTXT^"_$S(DSP:58,1:46)_"^"_$S(DSP:60,1:20)_"^Display Text"
57 S VALMDDF("ACT")="ACT^"_$S(DSP:119,1:67)_"^8^Active?"
58 S VALMDDF("EVENT")="EVENT^"_$S(DSP:127,1:76)_"^5^Event"
59 D CHGCAP^VALM("DISPTXT","Display Text") ;Causes caption line to be updated to new values set above
60 S VALMCNT=+$G(ORCNT)
61 Q
62 ;
63GETENTRY(ENTRY,DSP,LST,ORCNT,ORGLOB) ;
64 ;
65 N ZNODE,NAME,DN,ACT,ECODE,SP,CHILD,CHENTRY
66 I LST'="" Q:LST="A"&($G(@ORGLOB@(ENTRY,1))) Q:LST="I"&('$G(@ORGLOB@(ENTRY,1))) ;If not all then only active or inactive
67 S ZNODE=@ORGLOB@(ENTRY,0)
68 S CHILD=$S($P(ZNODE,U,12):1,1:0)
69 S NAME=$P(ZNODE,U) S:'DSP NAME=$E(NAME,1,$S(CHILD:38,1:40)) ;display is truncated
70 S DN=$S(ORGLOB["5":8,1:5),DN=$P(ZNODE,U,DN) S:'DSP DN=$E(DN,1,20) ;display is truncated
71 S ACT=$S($P($G(@ORGLOB@(ENTRY,1)),U):"N",1:"Y") ;rule active?
72 S ECODE=$P(ZNODE,U,2) S:ECODE=""&(CHILD) ECODE=$P(^ORD(100.5,$P(ZNODE,U,12),0),U,2) ;event code
73 S ORCNT=$G(ORCNT)+1,SP=$$REPEAT^XLFSTR(" ",$S(CHILD:6,1:4)-$L(ORCNT))
74 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)
75 I $D(^ORD(100.5,"DAD",ENTRY))&(ORTYPE="E") D
76 .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
77 Q
78 ;
79CHKSEL ;Evaluate selection if done by number
80 N ORJ,ORTMP,DIR,NUM,X,Y
81 S NUM=$P($G(XQORNOD(0)),"=",2) ;get currently selected entries
82 I NUM'="" D
83 .I NUM=$G(ORNMBR) D DESELECT Q ;If user selects same entry without taking an entry, unhighlight and stop processing
84 .D DESELECT:$G(ORNMBR) ;If user previously selected entries but took no action, unhighlight before highlighting new choices
85 .S ORNMBR=$P(XQORNOD(0),"=",2),DIR(0)="L^"_"1:"_VALMCNT,X=ORNMBR,DIR("V")="" D ^DIR K DIR
86 .I Y="" D FULL^VALM1 W !,"Invalid selection." S DIR(0)="E" D ^DIR K ORNMBR,DIR Q ;Selection out of range, stop processing
87 .F ORJ=1:1:$L(ORNMBR,",")-1 S ORTMP=$P(ORNMBR,",",ORJ) D CNTRL^VALM10(ORTMP,1,+$G(VALMWD),IORVON,IORVOFF)
88 Q
89 ;
90HELP ; -- help code
91 N X
92 S X="?" D DISP^XQORM1 W !!
93 Q
94 ;
95EXIT ; -- exit code
96 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
97 ;
98EEE ;Enter/edit events
99 N DIC,DLAYGO,ORJ,ORTMP,DA,DIE,DR,ORGLOB,NEW,TYPE,Y,DIDEL
100 D FULL^VALM1 ;get full screen
101 S VALMBCK="R"
102 S ORGLOB=$S(ORTYPE="E":"^ORD(100.5,",1:"^ORD(100.6,")
103 S DIDEL=$S(ORTYPE="E":100.5,1:100.6)
104 S DIC=ORGLOB
105 I $G(ORNMBR)="" S ORNMBR=$$ORDERS^OREV1("edit") Q:ORNMBR="^" ;If action selected before items, get items
106 I $G(ORNMBR)="" D Q
107 .S DLAYGO=$S(ORTYPE="E":100.5,1:100.6),DIC(0)="AEMQL"
108 .D ^DIC Q:Y=-1 S NEW=$S($L(Y,"^")=3:1,1:0),DIE=DIC,DA=+Y
109 .L +@(ORGLOB_DA_")"):1 I '$T W !!,"This entry is being edited by another user." H 3 Q
110 .I NEW D COPY(DA) S DR="1///"_$$NOW^XLFDT D ^DIE W !!,"NOTE: New entries start INACTIVATED.",! ;New entries start inactivated
111 .I 'NEW S TYPE=$P(@(ORGLOB_DA_",0)"),U,2)
112 .I ORTYPE="E" I $$RELEVNTS^OREV1(DA) W !!,$C(7),"** This event has delayed orders associated with it! **",!,"Editing will affect these delayed events.",!
113 .I ORTYPE="A" W !!,"Editing auto-dc rules takes effect immediately.",!
114 .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
115 .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
116 .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
117 .I $G(DA) D AUDIT(DA,$S($G(NEW):"N",1:"E")) ;If entry not deleted add to audit history
118 .I $G(DA) L -@(ORGLOB_DA_")")
119 ;
120 F ORJ=1:1:$L(ORNMBR,",")-1 S ORTMP=$P(ORNMBR,",",ORJ),DA=$O(^TMP("OREDO",$J,"IDX",ORTMP,0)) D
121 .W ! W:ORJ'=1 !,"**NOW EDITING NEXT ENTRY**",!
122 .L +@(ORGLOB_DA_")"):1 I '$T W !!,"This entry is being edited by another user." H 3 Q ;Lock global
123 .I ORTYPE="E" I $$RELEVNTS^OREV1(DA) W !!,$C(7),"** This event has delayed orders associated with it! **",!,"Editing will affect these delayed events.",!
124 .I ORTYPE="A" W !!,"Editing auto-dc rules takes effect immediately.",!
125 .S TYPE=$P(@(ORGLOB_DA_",0)"),U,2)
126 .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
127 .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
128 .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
129 .I $G(DA) D AUDIT(DA,"E") ;If entry not deleted add to audit history
130 .I $G(DA) L -@(ORGLOB_DA_")") ;Unlock global
131 K DIE("NO^") Q
132 ;
133DESELECT ;Un-highlight selected choices
134 N ORJ,ORTMP
135 F ORJ=1:1:$L($G(ORNMBR),",")-1 S ORTMP=$P(ORNMBR,",",ORJ) D CNTRL^VALM10(ORTMP,1,+$G(VALMWD),IORVOFF,IORVOFF)
136 K ORNMBR
137 Q
138 ;
139COPY(NEWENT) ;Allow new entries to copy from existing entries
140 N DIR,DLAYGO,DIC,DA,DIK,DIE,NAME,DIVISN,DR,Y
141 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
142 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
143 W !,"Copying..."
144 S NAME=$P(@(ORGLOB_NEWENT_",0)"),U) ;get name of new entry
145 S DIVISN=$P(@(ORGLOB_NEWENT_",0)"),U,3) ;get division of new entry
146 M @(ORGLOB_NEWENT_")")=@(ORGLOB_+Y_")")
147 K @(ORGLOB_NEWENT_",2)") ;Delete activation history that was copied
148 K @(ORGLOB_NEWENT_",9)") ;Delete audit history that was copied.
149 S DIK=DIC,DA=+Y D IX1^DIK ;set all xrefs for new entry
150 S DIE=ORGLOB,DA=NEWENT,DR=".01///"_NAME_";3///"_DIVISN D ^DIE ;reset name and division of new entry
151 Q
152 ;
153AUDIT(ENTRY,TYPE) ;Adds audit history for entry
154 N DIC,DA,DIE,X,Y,DR
155 S DA(1)=ENTRY,DIC(0)="L",X=$$NOW^XLFDT,DIC=ORGLOB_DA(1)_",9,"
156 D ^DIC Q:Y=-1 ;Stop processing if entry not added
157 S DIE=DIC K DIC
158 S DA=+Y
159 S DR="1///"_$S($G(DUZ):"`"_DUZ,1:"")_";2///"_TYPE D ^DIE
160 Q
161 ;
Note: See TracBrowser for help on using the repository browser.