| 1 | TIUSRVT3 ; 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 | ;
|
|---|
| 24 | SELUSR ; 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 | ;
|
|---|
| 68 | KUSER ; 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 | ;
|
|---|
| 85 | CLEAN(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 | ;
|
|---|
| 90 | CTRL ; 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 | ;
|
|---|
| 108 | DEL(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 | ;
|
|---|
| 129 | BLD(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 | ;
|
|---|
