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/XUSTERM1.m@ 789

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

initial load of WorldVistAEHR

File size: 4.5 KB
Line 
1XUSTERM1 ;SEA/WDE - DEACTIVATE USER ;6:40 AM 11 Oct 2006
2 ;;8.0;KERNEL;**102,180,208,222,274,313,332,360,384,436**;Jul 10, 1995;Build 2
3ENALL ;Interactive scan all
4 S U="^",DTIME=$G(DTIME,60)
5 W !!,"This option can purge all access & verify codes, mail baskets, messages,",!,"authorized senders access, keys, and electronic signature codes of users who have been terminated."
6RD1 W !!,"Do you wish to proceed "
7 S %=2 D YN^DICN G:%=2!(%=-1) END I %=0 S XQH="XUUSER-PURGEATT" D EN^XQH G RD1
8RD2 W !,"Do you wish to verify each user "
9 S %=2,XUVE=0 D YN^DICN S:%=1 XUVE=1 G:%=1 CHECK G:%=-1 END I %=0 S XQH="XUUSER-PURGEATT-VER" D EN^XQH G RD2
10QUE W !,"Do you wish to have this queued for a later time "
11 S %=1 D YN^DICN I %=1 D Q
12 . S ZTDESC="USER DEACTIVATION",ZTRTN="CHECK^XUSTERM1",ZTIO="",ZTSAVE("DUZ*")=""
13 . D ^%ZTLOAD
14 . Q
15 I %=0 K X,XUVE Q
16 ;Fall thru if user doesn't queue
17CHECK ;Entry point for taskman.
18 N XUDT540,XUDT90,XUDT30,FDA,XUDT
19 S U="^",DT=$$DT^XLFDT(),XUDT90=$$HTFM^XLFDT($H-90,1),XUDT30=$$HTFM^XLFDT($H-30,1)
20 S XUDT540=$$HTFM^XLFDT($H-540,1) ;*p332
21 S XUDA=.6,XUVE=$G(XUVE,0)
22 F S XUDA=$O(^VA(200,XUDA)) Q:XUDA'>0 S XUJ=$G(^(XUDA,0)) D
23 . S XUDT=$P(XUJ,U,11)
24 . I $P(XUJ,U,3)]"",$L(XUDT),(XUDT'>DT) D
25 . . D GET
26 . . I 'XUEMP K Y D:XUVE DISP Q:$D(Y) D ACT ;XUEMP=any data to remove
27 . . Q
28 . I $P(XUJ,U,3)]"",'$P(XUJ,U,8),$$NOSIGNON D DISUSER(XUDA)
29 . I $P(XUJ,U,7) D AUSER(XUDA) ;*p332
30 . Q
31 ;
32END K XUEMP,XUDA,XUI,XUJ,XUK,XUACT,XUKEY,XUGRP,XUSUR,XUNAM,XUF,XUDT,XUIN,XUVE,X,DIC,XUDB,XUDC,XUDP
33 Q
34 ;
35DISUSER(XUDA) ;Set DISUSER flag and reason, Remove last menu option
36 Q:$P(XUJ,U,7) ;DISUSER already set *p332
37 N %,FDA S %=XUDA_","
38 S FDA(200,%,7)=1,FDA(200,%,9.4)="User Inactive for too long"
39 D FILE^DIE("","FDA"),CONTCL(XUDA) ;Set Disuser
40 Q
41 ;
42AUSER(XUDA) ;If DISUSERed and Last Sign > 540[18Mo.*30] days, then remove"AUSER" xref
43 I $D(^XUSEC("XUORES",XUDA)) Q ;Owner of XUORES key ;p*436
44 N Q S Q=$P($G(^VA(200,XUDA,1.1)),U) ;Get last sign-on
45 I $L(Q),Q<XUDT540 K ^VA(200,"AUSER",$P(XUJ,U),XUDA) ;*p360;*p384
46 Q
47 ;
48NOSIGNON() ;Check last signon. Return 1 if should disable account
49 N Q S Q=$P($G(^VA(200,XUDA,1.1)),U) ;Get last sign-on
50 I $L(Q),Q>XUDT90 Q 0 ;Last sign-on within 90 days
51 S Q=$P($G(^VA(200,XUDA,1.1)),U,4) ;Get last Edit date
52 I $L(Q),Q>XUDT30 Q 0 ;User edited in last 30 days
53 S Q=$P($G(^VA(200,XUDA,1)),U,7) ;Create Date
54 I $L(Q),Q>XUDT30 Q 0 ;User set up in last 30 days
55 S Q=$P($G(^VA(200,XUDA,.1)),U) ;Get verify code change date
56 I $L(Q),(Q+30)>$H Q 0 ;Verify code changed in last 30 days
57 Q 1
58 ;
59CONTCL(XUDA) ;Clear the fields for Menu "Continue"
60 N FDA
61 S FDA(200,XUDA_",",202.1)="@",FDA(200,XUDA_",",202.2)="@"
62 D FILE^DIE("","FDA") ;Clear 202.1 and 202.2
63 Q
64 ;
65ACT ;
66 D ACT^XUSTERM
67 S XUJ=^VA(200,XUDA,0) ;Get new copy of zero node
68 Q
69 ;
70GET ;Kill ^DISV entries each time, should get all CPUs at some point
71 N XUJ
72 D GET^XUSTERM K ^DISV(XUDA),Y
73 Q
74DISP ;Display info and get responses.
75 N DA,DIE,DR,XUJ
76 S DA=XUDA
77 L +^VA(200,DA,0):6 D DISP2 L -^VA(200,DA,0)
78 Q
79DISP2 ;Do the work.
80 W !!,$S(XUTX1(1)["User":XUNAM_$P(XUTX1(1),"User",2),1:XUTX1(1)) ;*p360
81 S DR="9.21//YES",DIE=200 D ^DIE Q:$D(Y) G:'$D(XUSUR) KEYS
82 W !!,XUNAM," acts as surrogate for the following users:"
83 S XUJ=0,XUI=3 F XUK=0:1 S XUJ=$O(XUSUR(XUJ)) Q:XUJ'>0 W:'(XUK#XUI) ! W ?(XUK#XUI*26),$P(^VA(200,XUJ,0),U,1) W !,"These surrogate privileges will be deleted on deactivation."
84KEYS ;This section checks for authorized senders of mail groups and security keys.
85 W !,"User will no longer be an authorized sender to any mail groups."
86 I '$D(XUKEY) W !!,XUNAM," currently holds no keys." G KEYS1
87 W !!,XUNAM," holds the following keys: "
88 S XUJ=0,XUI=5 F XUK=0:1 S XUJ=$O(XUKEY(XUJ)) Q:XUJ'>0 W:'(XUK#XUI) ! W ?(XUK#XUI*15),$P($G(^DIC(19.1,XUJ,0)),U,1)
89KEYS1 W ! S DR="9.22//YES" D ^DIE Q:$D(Y)
90GROUP I '$D(XUGRP) W !!,XUNAM," currently is not a member of any MAIL GROUP." G GROUP1
91 W !!,XUNAM," is a member of the following Mail Groups:"
92 S XUI="" F XUI=0:0 S XUI=$O(XUGRP(XUI)) Q:XUI'>0 D
93 . S XUJ=XUGRP(XUI)
94 . I $P(XUJ,U,2)="PU"!$D(^XMB(3.8,"AB",XUDA,XUI)) W !?2,$P(XUJ,U,1) W:$P(XUJ,U,3) " (Organizer)" W ?40,$S(($P(XUJ,U,2)="PR"):"(Private)",1:"(Public)")
95 . Q
96GROUP1 W ! S DR="9.23//YES" D ^DIE Q:$D(Y)
97 Q
98 ;
99DQ1 ;Terminate one person.
100 N XUJ,XUDT,XUVE
101 S XUJ=$G(^VA(200,XUDA,0)),XUDT=$P(XUJ,U,11) I XUDT,(XUDT'>DT) D
102 . S XUVE=0 D GET I 'XUEMP D ACT
103 . Q
104 Q
105 ;
106SEND ; send deactivated message to assigned mail group
107 K XMB,XMY
108 S XMB(1)=$P(XUJ,"^",1)
109 S XMB(2)=$$GET1^DIQ(200,XUDA,8)
110 S XMB(3)=$$GET1^DIQ(200,XUDA,29)
111 S XMB(4)=$$FMTE^XLFDT(XUDT)
112 S XMB="XUSERDEAC" D ^XMB:$D(^XMB(3.6,"B",XMB))
113 K XMB
114 Q
Note: See TracBrowser for help on using the repository browser.