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

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

initial load of FOIAVistA 6/30/08 version

File size: 3.1 KB
Line 
1XQSMD2 ; SEA/MJM - Secure MenuMan Delegation (Cont.) ;7/3/91 08:42 ;8/21/92 11:58 AM
2 ;;8.0;KERNEL;;Jul 10, 1995
3 S U="^",XQMG=DUZ,XQNGO=0
4BUILD ;Put remaining options into Delgate Options File
5 S (XQM,XQN)="" D LIST I XQM=-1!(XQN=-1) G OUT
6 D:$Y+2>IOSL WAIT W !!!,"Ready to ",$S(XQDOP:"remove these options from",1:"delegate these options to")," these people? Y// " R XQ:DTIME S:'$T XQ=U G:XQ=U OUT S:XQ="" XQ="Y" G:"YyNn"'[XQ BUILD
7 I XQ["N"!(XQ["n") W !!,"Fine, you may edit the user or option list, or enter a '^' to quit." G NAME^XQSMD
8 I '$D(^TMP($J,"OP")) W !!,"No options found, no action taken.",*7 G OUT
9 ;
10ZTLOAD ;Set up Taskman parameters an queue the request
11 S ZTRTN="ZTSK^XQSMD31",ZTDTH=$H,ZTIO="",(XQDESC,ZTDESC)=XQMGR_" "_$S(XQDOP:"remov",1:"add")_"ing delegated options"
12 S ZTSAVE("^TMP($J,")="",ZTSAVE("XQDOP")="",ZTSAVE("XQLEV")="",ZTSAVE("XQHOLD(")="",ZTSAVE("XQPRO")=""
13 D ^%ZTLOAD
14 W !!,"Request to ",$S(XQDOP:"remove",1:"add")," delegated options has been queued, task # ",ZTSK,",",!?5,"named: ",XQDESC,"."
15 ;
16SCAN ;Scan selected options for restrictions and report them
17 S XQN=""
18 F XQI=0:0 D:$Y+3>IOSL WAIT Q:XQ=U S XQN=$O(^TMP($J,"ZN",XQN)) Q:XQN="" S XQON0=^(XQN) S:$L($P(XQON0,U,5)) XQLK(XQN)=$P(XQON0,U,5) D:$L($P(XQON0,U,2)) OOO D RTIM D:$L($P(XQON0,U,9)) RDEV
19 S XQKEY(0)="",XQN="",DIC=19.1,DIC(0)="FMXZ",XQI=0
20 F XQJ=0:0 S XQN=$O(XQLK(XQN)) Q:XQN="" S X=XQLK(XQN) D ^DIC I Y>0,'$D(XQKEY(+Y)),$S($D(^XUSEC("XUMGR",DUZ)):1,$D(^VA(200,DUZ,52,"B",+Y)):1,1:0) S XQKEY(+Y)="",XQI=XQI+1
21 ;
22 I $O(XQKEY(0))'="" D KEYS^XQSMD21 ;Allocate keys for locked options
23 ;
24 G OUT
25 Q
26 ;
27OOO W !,XQN," is out of order with the string: '",$P(XQON0,U,2),"'" Q
28 ;
29RTIM ; Identify and display prohibited times for option
30 S %A="",XQON=$O(^DIC(19,"B",XQN,0)) I $D(^DIC(19,XQON,3.91)) F %XQI=0:0 S %XQI=$O(^DIC(19,XQON,3.91,%XQI)) Q:%XQI'>0 W !,XQN," is PROHIBITED during the times ",$P(^(%XQI,0),U,1),$P(^(0),U,2)," (military time)." K %A
31 K %XQI I $D(%A) K %A I $L($P(XQON0,U,8)) W !,XQN," is PROHIBITED during the times ",$P(XQON0,U,8)," (military time)."
32 Q
33 ;
34RDEV W !,XQN," is restricted to run on only certain devices." Q
35 ;
36LIST ;List users and options selected so far.
37 W @IOF S (XQT,XQM)=0,XQM=$O(XQHOLD(XQM)) I XQM="" W !!," No users selected yet." S XQM=-1 Q
38 W !!,"For the following user(s):",!
39 F XQI=1:1 D:$Y+2>IOSL WAIT Q:XQ=U W:'(XQT#2) ! W ?(XQT#2*35),XQI,". ",XQHOLD(XQM) S XQT=XQT+1,XQM=$O(XQHOLD(XQM)) Q:XQM=""
40 W !!,"You will ",$S(XQDOP:"remove ",1:"delegate "),"the following options: ",!
41 S XQT=0,XQN="",XQN=$O(^TMP($J,"ZN",XQN)) I XQN="" W !!,"No menu options selected yet" S XQN=-1 Q
42 F XQI=0:0 D:$Y+2>IOSL WAIT Q:XQ=U W !,XQN," ",$P(^TMP($J,"ZN",XQN),U,1) S XQN=$O(^(XQN)) Q:XQN=""
43 W !!,$S(XQDOP:" Removed ",1:" Delegated "),"by ",XQMGR," on ",XQDATE,".",!
44 S XQ=""
45 Q
46WAIT ;Skip to the head of the next page
47 I 1 S XQ="" R:IOST["C-" !?26,"Press RETURN to continue,'^' to quit.",XQ:DTIME S:'$T XQ=U W @IOF
48 Q
49 ;
50OUT K DIC,DIK,DA,DISYS,DINUM,POP,XQ,XQH,XQI,XQJ,XQK,XQL,XQM,XQN,XQT,XQON0,XQAL,XQDATE,XQDEL,XQDESC,XQDT,XQDUZ,XQLEV,XQLK,XQMG,XQMGR,XQNAM,XQNGO,XQUF,XQPRO,XQSTART,XQEND,XQHOLD,XQKEY,ZTSK,X,Y,XY,%,^TMP($J)
51 K ZTRTN,ZTDTH,ZTIO,ZTDESC,ZTSAVE,XQDOP,C,XQU1L
52 Q
Note: See TracBrowser for help on using the repository browser.