source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUSRVT4.m@ 1361

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

initial load of WorldVistAEHR
File size: 3.2 KB
RevLine 
[613]1TIUSRVT4 ; SLC/PKS Remove all terminated user Templates. ; [3/15/01 12:15pm]
2 ;;1.0;TEXT INTEGRATION UTILITIES;**110**;Jun 20, 1997
3 ;
4 ; Variables used herein:
5 ;
6 ; TIUANS = Result of call to $$VERIF.
7 ; TIUARY = Array holder.
8 ; TIUCNT = Counter Variable.
9 ; TIUERR = Error array for call return.
10 ; TIUIDX = X-ref holder.
11 ; TIUIEN = Template IEN holder.
12 ; TIUNOW = Current date.
13 ; TIUNUM = Loop counter.
14 ; TIUSR = Terminated user (DUZ).
15 ; TIUSTAT = Status of user.
16 ; TIUTMP = Call return array value holder.
17 ; TIUTPLT = Template IEN.
18 ;
19 Q
20 ;
21CTRL ; Main control section.
22 ;
23 N TIUANS,TIUCNT,TIUERR,TIUIDX,TIUNOW,TIUSR,TIUSTAT,TIUTPLT
24 ;
25 S TIUANS=$$VERIF ; Confirm before deleting.
26 I 'TIUANS Q ; User failed to confirm - quit.
27 ;
28 D EACH ; Call to process template cleanup.
29 ;
30 Q
31 ;
32EACH ; Process template deletion for each user found who has any.
33 ;
34 ; Get current date information:
35 D NOW^%DTC
36 S TIUNOW=X
37 K X
38 ;
39 ; Retrieve each user in ^TIU(8927 file:
40 S TIUSR=0
41 F D Q:'TIUSR
42 .S TIUSR=$O(^TIU(8927,"AROOT",TIUSR))
43 .I 'TIUSR Q
44 .;
45 .; Check user's status - look for terminated users:
46 .I '$D(^VA(200,TIUSR,0)) Q ; No user record.
47 .I '$L($P($G(^VA(200,TIUSR,0)),"^",1)) Q ; Invalid user data.
48 .S TIUSTAT=$$GET1^DIQ(200,TIUSR,9.2,"I",,.TIUERR) ; Termination date?
49 .I 'TIUSTAT Q ; Active user.
50 .I TIUSTAT>TIUNOW Q ; User terminated on a future date.
51 .;
52 .; User terminated, effective today or earlier, so proceed:
53 .; Find AROOT x-ref record, if any:
54 .S TIUTPLT=0
55 .F D Q:'TIUTPLT
56 ..S TIUTPLT=$O(^TIU(8927,"AROOT",TIUSR,TIUTPLT))
57 ..I 'TIUTPLT Q
58 ..;
59 ..; Get any existing templates, delete them:
60 ..D DEL(TIUTPLT)
61 ;
62 Q
63 ;
64DEL(TIUIEN) ; Pass root node of AROOT x-ref.
65 ;
66 N TIUARY,TIUNUM,TIUTMP
67 ;
68 D BLD(TIUIEN,.TIUARY) ; Recursive call.
69 ;
70 D DELETE^TIUSRVT(.TIUTMP,.TIUARY) ; Kill record(s).
71 ;
72 Q
73 ;
74BLD(TIUIEN,TIUARY) ; Build array of templates for user.
75 ;
76 N TIUIDX
77 ;
78 S TIUIDX=$O(TIUARY(" "),-1)+1
79 S TIUARY(TIUIDX)=TIUIEN
80 S TIUIDX=0
81 F S TIUIDX=$O(^TIU(8927,TIUIEN,10,TIUIDX)) Q:'TIUIDX D
82 .D BLD($P(^TIU(8927,TIUIEN,10,TIUIDX,0),U,2),.TIUARY)
83 ;
84 Q
85 ;
86PARSET ; Edit parameter for auto-cleanup of templates upon termination.
87 ;
88 D EDITPAR^XPAREDIT("TIU TEMPLATE USER AUTO DELETE")
89 ;
90 Q
91 ;
92VERIF() ; Verify that user really wants to execute this option:
93 ;
94 N DIR,X,Y ; DIR variables.
95 S DIR("T")=120 ; Two minute maximum timeout for response.
96 S DIR("A")=" Delete all non-shared templates for all terminated users (Y/N)"
97 S DIR("?")=" Templates for terminated users will be permanently lost..."
98 S DIR("B")="NO" ; Default.
99 ;
100 ; Define DIR input requirements:
101 S DIR(0)="YO^1:2:0"
102 ;
103 ; Call DIR for user choice:
104 W !! ; Spacing for screen display.
105 D ^DIR
106 ;
107 ; Check user response:
108 I '$L($G(Y)) Q 0 ; Skip if Y isn't assigned.
109 I Y="" Q 0 ; Skip if Y is null.
110 I Y="^" Q 0 ; Skip if Y is "^" character.
111 I Y<1 Q 0 ; Skip if Y is less than one.
112 I Y>2 Q 0 ; "No" choice.
113 I Y=1 Q 1 ; "Yes" choice.
114 ;
115 Q 0 ; Default return of "No."
116 ;
Note: See TracBrowser for help on using the repository browser.