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/XUSMGR.m@ 1806

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

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1XUSMGR ;SF-ISC/STAFF - SECURITY UTILITIES ROUTINE ; 7/15/03 7:03am
2 ;;8.0;KERNEL;**263,258,314**;Jul 10, 1995
3 W !!,"Use the MENU system",!! Q
4X1 ;Old intro test edit
5 N DIE,DA,DR
6 W !!,"Please use menu option 'Inrtoductory text edit'" H 4 ;Sign-on intro text.
7 S DIE="^XTV(8989.3,",DA=1,DR=240 D ^DIE Q
8 ;
9X6 ;Clear Terminal
10 N %ZIS
11 S %ZIS="QN" D ^%ZIS G:POP EX6 I '$D(^DISV("XU",IOS)) W !!,$C(7),"Terminal does not need to be cleared!!!",! G X6
12 K ^DISV("XU",IOS),%ZIS W !,"Terminal has been CLEARED!!",!
13EX6 D HOME^%ZIS Q
14 ;
15X8 ;Release user
16 N DIC,DIR,J,X,Y,FDA,IEN,X1,X2,X3
17X8A W !!,"This will clear the user from the list of currently sign-on users."
18 W !,"And/or release from invalid sign on lock."
19 S DIC="^VA(200,",DIC(0)="AEMQ" D ^DIC S IEN=+Y G:Y<1 EX8
20 S (X1,X2,X3)=0
21 I $P($G(^VA(200,IEN,1.1)),"^",3) S X1=1
22 I $P($G(^VA(200,IEN,1.1)),"^",5) S X2=1
23 I $D(^XUSEC(0,"CUR",IEN)) S X3=1
24 I '(X1+X2+X3) D G X8
25 . W !!,$C(7),"User is not currently recorded as being signed on the system!!!",!
26 ;Show user info
27 W !,"User: ",$P(Y,U,2)," is listed with the following connections."
28 S J=0 F S J=$O(^XUSEC(0,"CUR",IEN,J)) Q:J'>0 D
29 . I '$D(^XUSEC(0,J,0)) K ^XUSEC(0,"CUR",IEN,J) Q
30 . S X=^XUSEC(0,J,0)
31 . W !,"Connected: ",$$FMTE^XLFDT(J,"1"),?39," Device: ",$P(X,U,2)
32 . W !,?2," Node: ",$P(X,U,10),?39," IP: ",$S($L($P(X,U,11)):$P(X,U,11),1:$P(X,U,12))
33 . Q
34 I $P(^VA(200,IEN,1.1),U,5) W !,"Locked out until ",$$FMTE^XLFDT($P(^VA(200,IEN,1.1),U,5))," because of too many invalid attempts."
35 ;
36 S DIR(0)="Y",DIR("A")="Release this user",DIR("B")="Yes" D ^DIR
37 I 'Y G X8A
38 S $P(^VA(200,IEN,1.1),"^",3)=0,$P(^VA(200,IEN,1.1),U,5)="" ;Clear flag,Lockout time
39 S J=0 F S J=$O(^XUSEC(0,"CUR",IEN,J)) Q:J'>0 D
40 . S FDA(3.081,J_",",3)=$$NOW^XLFDT,FDA(3.081,J_",",16)=1 D UPDATE^DIE("","FDA")
41 W !,"User is RELEASED!!",!
42EX8 Q
43 ;
44SCPURG ;Purge sign-on log
45 S XUDT=$$HTFM^XLFDT($H-30) I $O(^XUSEC(0,0))'>0 G SCEXIT
46 S DIK="^XUSEC(0," F DA=0:0 S DA=$O(^XUSEC(0,DA)) Q:(DA'>0)!(DA>XUDT) D ^DIK
47SCEXIT K DIK,DA,XUDT,X1,X2 Q
48IXKEY ;Re-Index the New Person file Key sub-file
49 N DA,DIK,ACT
50 W:'$D(ZTQUEUED) !,"Starting"
51 ;we only want to reindex the "AC" x-ref
52 S DIK(1)=".01^AC"
53 ;loop through New Person file and index entries
54 F DA(1)=0:0 S DA(1)=$O(^VA(200,DA(1))) Q:DA(1)'>0 D
55 .;skip inactive person
56 .;Q:$P($G(^VA(200,DA(1),0)),"^",11)
57 .S ACT=+$$ACTIVE^XUSER(DA(1))
58 .I ACT'=1 Q
59 .;global root for multiple
60 .S DIK="^VA(200,DA(1),51,"
61 .;reindex
62 .D ENALL^DIK W:'(DA(1)#50) "."
63 .;
64 W:'$D(ZTQUEUED) !,"Done"
65 ;
66 ;the old codes
67 ;W:'$D(ZTQUEUED) !,"Starting "
68 ;S DIK="^VA(200,DA(1),51,",DIK(1)=".01^1^2^3^4"
69 ;F DA(1)=0:0 S DA(1)=$O(^VA(200,DA(1))) Q:DA(1)'>0 D ENALL^DIK W:'(DA(1)#50) "."
70 ;W:'$D(ZTQUEUED) !,"Done"
71 Q
Note: See TracBrowser for help on using the repository browser.