source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUSRVT3.m@ 1766

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

initial load of WorldVistAEHR

File size: 4.3 KB
Line 
1TIUSRVT3 ; SLC/PKS Remove a user's non-shared Templates. ; [6/26/01 9:17am]
2 ;;1.0;TEXT INTEGRATION UTILITIES;**110**;Jun 20, 1997
3 ;
4 ; Variables used herein:
5 ;
6 ; DIR = FM call varible.
7 ; TIUARY = Array holder.
8 ; TIUCNT = Returned array counter.
9 ; TIUGET = Holder for returned array $O command.
10 ; TIUIDX = X-ref holder.
11 ; TIUIEN = Template IEN holder.
12 ; TIUNM = Holder variable for name of user.
13 ; TIUNUM = Loop counter from this routine.
14 ; TIUPAR = Current setting of auto-cleanup parameter.
15 ; TIURARY = Returned array; zero node will contain user's DUZ and
16 ; AROOT IEN (if any) or error message (RPC use only).
17 ; TIUSR = DUZ of user to process.
18 ; TIUTMP = Call return array values holder.
19 ; TIUTPLT = Template IEN.
20 ; X,Y = Variables for FM call.
21 ;
22 Q
23 ;
24SELUSR ; Call here for manual selection of TIUSR from NEW PERSON file.
25 ;
26 N DIR,TIUCNT,TIUGET,TIUIDX,TIUNM,TIUNUM,TIUTPLT,TIURARY,TIUSR,X,Y
27 ;
28 ; Get input for user:
29 S TIUSR="" ; Default.
30 S DIR(0)="PAO^200,:AEMNQ"
31 S DIR("A")=" Enter/select user for whom templates will be deleted: "
32 S DIR("?")="Specify user for template cleanup."
33 D ^DIR
34 S TIUSR=Y
35 K DIR,X,Y ; Clean up from FM call.
36 I TIUSR<1 S TIUSR="" Q ; No acceptable entry.
37 S TIUSR=+TIUSR ; Selected user's DUZ.
38 I TIUSR="" Q ; Punt here if there's a problem.
39 ;
40 ; Confirm before deletion:
41 S TIUNM=$P($G(^VA(200,TIUSR,0)),U,1)
42 S DIR("T")=120 ; Two minute maximum timeout for response.
43 S DIR("A")=" Delete all non-shared templates for user "_TIUNM_" (Y/N)"
44 S DIR("?")=" Non-shared templates for this user will be permanently lost..."
45 S DIR("B")="NO" ; Default.
46 ;
47 ; Define DIR input requirements:
48 S DIR(0)="YO^1:2:0"
49 ;
50 ; Call DIR for user choice:
51 W !! ; Spacing for screen display.
52 D ^DIR
53 ;
54 ; Check user response:
55 I '$L($G(Y)) Q ; Skip if Y isn't assigned.
56 I Y="" Q ; Skip if Y is null.
57 I Y="^" Q ; Skip if Y is "^" character.
58 I Y<1 Q ; Skip if Y is less than one.
59 I Y>2 Q ; "No" choice.
60 K DIR,X,Y ; Clean up from FM call.
61 ;
62 ; Proceed with clean up:
63 D CTRL
64 K TIURARY ; Array not returned under manual functionality.
65 ;
66 Q
67 ;
68KUSER ; Get USER from Kernel - called by option: TIU TEMPLATE USER DELETE.
69 ;
70 ; See if this function is "active" by checking Parameter:
71 ;
72 N TIUCNT,TIUGET,TIUIDX,TIUNUM,TIUTPLT,TIUPAR,TIURARY,TIUSR
73 S TIUPAR=$$GET^XPAR("DIV^SYS^PKG","TIU TEMPLATE USER AUTO DELETE",1,"E")
74 I TIUPAR'="YES" Q
75 I TIUPAR="" Q
76 ;
77 ; Parameter set to activate auto-cleanup - proceed:
78 S TIUSR=$GET(XUIFN) ; Assign TIUSR variable.
79 I TIUSR="" Q ; Punt here if there's a problem.
80 D CTRL
81 K TIURARY ; Array not returned when triggered by Kernel.
82 ;
83 Q
84 ;
85CLEAN(TIUSR,TIURARY) ; Call here as an RPC: Dump templates for one user.
86 ;
87 N TIUCNT,TIUGET,TIUIDX,TIUNUM,TIUTPLT
88 I 'TIUSR>0 S TIURARY(0)="No user DUZ passed." Q
89 ;
90CTRL ; Main control code for actual cleanup process.
91 ;
92 S TIUCNT=0
93 ;
94 ; See if there is an AROOT x-ref entry for this user:
95 I '$D(^TIU(8927,"AROOT",TIUSR)) S TIURARY(0)="No AROOT record." Q
96 ;
97 ; Get parent record for user's templates:
98 S TIUTPLT=0
99 F D Q:'TIUTPLT
100 .S TIUTPLT=$O(^TIU(8927,"AROOT",TIUSR,TIUTPLT))
101 .I 'TIUTPLT Q
102 .;
103 .; Compile an array of applicable templates:
104 .D DEL(TIUTPLT)
105 ;
106 Q
107 ;
108DEL(TIUIEN) ; Pass root node of AROOT x-ref of <^TIU(8927,> file.
109 ;
110 N TIUARY,TIUTMP
111 ;
112 S TIURARY(TIUCNT)=TIUSR_U_TIUIEN ; 0-node: "UserDUZ^ARootIEN" format.
113 D BLD(TIUIEN,.TIUARY) ; Recursive array builder.
114 ;
115 ; Create or add to return array:
116 S (TIUGET,TIUNUM)=0
117 F D Q:'TIUGET
118 .S TIUNUM=TIUNUM+1
119 .S TIUGET=$G(TIUARY(TIUNUM))
120 .I 'TIUGET Q
121 .S TIUCNT=TIUCNT+1
122 .S TIURARY(TIUCNT)=TIUGET
123 ;
124 ; Using the array of templates, make call that kills only orphans:
125 D DELETE^TIUSRVT(.TIUTMP,.TIUARY)
126 ;
127 Q
128 ;
129BLD(TIUIEN,TIUARY) ; Recursively build an array of templates.
130 ;
131 N TIUIDX
132 ;
133 S TIUIDX=$O(TIUARY(" "),-1)+1
134 S TIUARY(TIUIDX)=TIUIEN
135 S TIUIDX=0
136 F S TIUIDX=$O(^TIU(8927,TIUIEN,10,TIUIDX)) Q:'TIUIDX D
137 .D BLD($P(^TIU(8927,TIUIEN,10,TIUIDX,0),U,2),.TIUARY)
138 ;
139 Q
140 ;
Note: See TracBrowser for help on using the repository browser.