source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XQ7.m@ 1437

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

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1XQ7 ;SF-ISC..SEA/JLI - MICROSURGERY OF XUTL MENU TREES ;01/09/2001 13:29
2 ;;8.0;KERNEL;**44,60,155**;Jul 10, 1995
3REDO ; All changes to an option come here, i.e., menu text, locks, prohibited times, etc.
4 S XQFLAG=DA
5 S %H=$H F %=0:0 S %=$O(^DIC(19,"AD",DA,%)) Q:%'>0 S ^DIC(19,%,99)=%H I '$D(^DIC(19,%,0)) K ^DIC(19,%),^DIC(19,"AD",DA,%)
6 F %=0:0 S %=$O(^VA(200,"AD",DA,%)) Q:%'>0 S ^VA(200,%,203.1)=%H
7 ;
8FLAG ;
9 S ^DIC(19,"AT",$$NOW^XLFDT(),XQFLAG)=""
10 K %,%H,XQFLAG
11 Q
12 ;
13REDOX ;
14 S %H=$H,^DIC(19,DA(1),99)=%H
15 F %=0:0 S %=$O(^VA(200,"AD",DA(1),%)) Q:%'>0 S ^VA(200,%,203.1)=%H
16 Q
17 ;
18REDOXI ; Insertion of an item on a menu
19 D REDOX
20 S XQFLAG=DA(1)_"I"_X G FLAG
21 ;
22REDOXD ; Deletion of an item from a menu
23 D REDOX
24 S XQFLAG=DA(1)_"D"_X G FLAG
25 ;
26REDOXS ; Change or addition of a synonym
27 D REDOX
28 S XQFLAG=DA(1)_"S"_(+^DIC(19,DA(1),10,DA,0)) G FLAG
29 ;
30REDOXZ ; Change in display order, does not affect trees
31 D REDOX K %,%H
32 Q
33REDOXP ; Check for new primary menu added to user file
34 Q:$D(^XUTL("XQO","P"_X))
35 S XQFLAG=X_"P"_X G FLAG
36 ;
37CK ;Called from several places in ^DD(19,
38 I $D(DIFROM) Q
39 S %=$P(^DIC(19,D0,0),U,6),%Y=$P(^DIC(19,D0,0),U,1) I $S($L(%):$D(^XUSEC(%,DUZ)),1:1)
40 Q:'$T
41 I DUZ(0)="@"!$D(^XUSEC("XUMGR",DUZ))!$D(^VA(200,DUZ,19.5,Y,0))
42 Q:'$T
43CK1 S %=$P(^DIC(19,D0,0),U,4),%Y=$P(^DIC(19,Y,0),U,4) I $S((%'="O"&(%'="Q"))&(%Y'="Q"):1,(%="O"&(%Y="O")):1,(%="Q"&((%Y="O")!(%Y="Q"))):1,1:0)
44 Q
45DEV ;See if device is legit for this option. Called by CHK1+5^XQ71.
46 S (%,XQSJ)=0 Q:'$D(^DIC(19,+XQW,3.96,0))
47 F XQSL=1:1 S %=$O(^DIC(19,+XQW,3.96,%)) Q:%=""!(%'=+%) S:XQSIO=^(%,0) XQSJ=1
48 Q
49UP S X=$$UP^XLFSTR(X) ;F XQSA=1:1 Q:X?.NUP S %=$A(X,XQSA) I %<123,%>96 S X=$E(X,1,XQSA-1)_$C(%-32)_$E(X,XQSA+1,255)
50 Q
51 ;
52KICK ;Kick off microsurgery here and all compute servers
53 D CHEK^XQ83
54 Q:'$D(^%ZIS(14.5))
55 N XQ,XQVOL,XQTIM,ZTCPU
56 S XQTIM=$P($H,",")-1_","_$P($H,",",2)
57 S XQ=0 F S XQ=$O(^%ZIS(14.5,XQ)) Q:XQ=""!(XQ'=+XQ) I $P(^(XQ,0),U,11) D
58 .S ZTCPU=$P(^%ZIS(14.5,XQ,0),U) D CHEK^XQ83
59 Q
Note: See TracBrowser for help on using the repository browser.