TIUSRVT3 ; SLC/PKS Remove a user's non-shared Templates. ; [6/26/01 9:17am]
;;1.0;TEXT INTEGRATION UTILITIES;**110**;Jun 20, 1997
;
; Variables used herein:
;
; DIR = FM call varible.
; TIUARY = Array holder.
; TIUCNT = Returned array counter.
; TIUGET = Holder for returned array $O command.
; TIUIDX = X-ref holder.
; TIUIEN = Template IEN holder.
; TIUNM = Holder variable for name of user.
; TIUNUM = Loop counter from this routine.
; TIUPAR = Current setting of auto-cleanup parameter.
; TIURARY = Returned array; zero node will contain user's DUZ and
; AROOT IEN (if any) or error message (RPC use only).
; TIUSR = DUZ of user to process.
; TIUTMP = Call return array values holder.
; TIUTPLT = Template IEN.
; X,Y = Variables for FM call.
;
Q
;
SELUSR ; Call here for manual selection of TIUSR from NEW PERSON file.
;
N DIR,TIUCNT,TIUGET,TIUIDX,TIUNM,TIUNUM,TIUTPLT,TIURARY,TIUSR,X,Y
;
; Get input for user:
S TIUSR="" ; Default.
S DIR(0)="PAO^200,:AEMNQ"
S DIR("A")=" Enter/select user for whom templates will be deleted: "
S DIR("?")="Specify user for template cleanup."
D ^DIR
S TIUSR=Y
K DIR,X,Y ; Clean up from FM call.
I TIUSR<1 S TIUSR="" Q ; No acceptable entry.
S TIUSR=+TIUSR ; Selected user's DUZ.
I TIUSR="" Q ; Punt here if there's a problem.
;
; Confirm before deletion:
S TIUNM=$P($G(^VA(200,TIUSR,0)),U,1)
S DIR("T")=120 ; Two minute maximum timeout for response.
S DIR("A")=" Delete all non-shared templates for user "_TIUNM_" (Y/N)"
S DIR("?")=" Non-shared templates for this user will be permanently lost..."
S DIR("B")="NO" ; Default.
;
; Define DIR input requirements:
S DIR(0)="YO^1:2:0"
;
; Call DIR for user choice:
W !! ; Spacing for screen display.
D ^DIR
;
; Check user response:
I '$L($G(Y)) Q ; Skip if Y isn't assigned.
I Y="" Q ; Skip if Y is null.
I Y="^" Q ; Skip if Y is "^" character.
I Y<1 Q ; Skip if Y is less than one.
I Y>2 Q ; "No" choice.
K DIR,X,Y ; Clean up from FM call.
;
; Proceed with clean up:
D CTRL
K TIURARY ; Array not returned under manual functionality.
;
Q
;
KUSER ; Get USER from Kernel - called by option: TIU TEMPLATE USER DELETE.
;
; See if this function is "active" by checking Parameter:
;
N TIUCNT,TIUGET,TIUIDX,TIUNUM,TIUTPLT,TIUPAR,TIURARY,TIUSR
S TIUPAR=$$GET^XPAR("DIV^SYS^PKG","TIU TEMPLATE USER AUTO DELETE",1,"E")
I TIUPAR'="YES" Q
I TIUPAR="" Q
;
; Parameter set to activate auto-cleanup - proceed:
S TIUSR=$GET(XUIFN) ; Assign TIUSR variable.
I TIUSR="" Q ; Punt here if there's a problem.
D CTRL
K TIURARY ; Array not returned when triggered by Kernel.
;
Q
;
CLEAN(TIUSR,TIURARY) ; Call here as an RPC: Dump templates for one user.
;
N TIUCNT,TIUGET,TIUIDX,TIUNUM,TIUTPLT
I 'TIUSR>0 S TIURARY(0)="No user DUZ passed." Q
;
CTRL ; Main control code for actual cleanup process.
;
S TIUCNT=0
;
; See if there is an AROOT x-ref entry for this user:
I '$D(^TIU(8927,"AROOT",TIUSR)) S TIURARY(0)="No AROOT record." Q
;
; Get parent record for user's templates:
S TIUTPLT=0
F D Q:'TIUTPLT
.S TIUTPLT=$O(^TIU(8927,"AROOT",TIUSR,TIUTPLT))
.I 'TIUTPLT Q
.;
.; Compile an array of applicable templates:
.D DEL(TIUTPLT)
;
Q
;
DEL(TIUIEN) ; Pass root node of AROOT x-ref of <^TIU(8927,> file.
;
N TIUARY,TIUTMP
;
S TIURARY(TIUCNT)=TIUSR_U_TIUIEN ; 0-node: "UserDUZ^ARootIEN" format.
D BLD(TIUIEN,.TIUARY) ; Recursive array builder.
;
; Create or add to return array:
S (TIUGET,TIUNUM)=0
F D Q:'TIUGET
.S TIUNUM=TIUNUM+1
.S TIUGET=$G(TIUARY(TIUNUM))
.I 'TIUGET Q
.S TIUCNT=TIUCNT+1
.S TIURARY(TIUCNT)=TIUGET
;
; Using the array of templates, make call that kills only orphans:
D DELETE^TIUSRVT(.TIUTMP,.TIUARY)
;
Q
;
BLD(TIUIEN,TIUARY) ; Recursively build an array of templates.
;
N TIUIDX
;
S TIUIDX=$O(TIUARY(" "),-1)+1
S TIUARY(TIUIDX)=TIUIEN
S TIUIDX=0
F S TIUIDX=$O(^TIU(8927,TIUIEN,10,TIUIDX)) Q:'TIUIDX D
.D BLD($P(^TIU(8927,TIUIEN,10,TIUIDX,0),U,2),.TIUARY)
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUSRVT3 4501 printed Apr 09, 2024@21:47:42 Page 2
TIUSRVT3 ; SLC/PKS Remove a user's non-shared Templates. ; [6/26/01 9:17am]
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**110**;Jun 20, 1997
+2 ;
+3 ; Variables used herein:
+4 ;
+5 ; DIR = FM call varible.
+6 ; TIUARY = Array holder.
+7 ; TIUCNT = Returned array counter.
+8 ; TIUGET = Holder for returned array $O command.
+9 ; TIUIDX = X-ref holder.
+10 ; TIUIEN = Template IEN holder.
+11 ; TIUNM = Holder variable for name of user.
+12 ; TIUNUM = Loop counter from this routine.
+13 ; TIUPAR = Current setting of auto-cleanup parameter.
+14 ; TIURARY = Returned array; zero node will contain user's DUZ and
+15 ; AROOT IEN (if any) or error message (RPC use only).
+16 ; TIUSR = DUZ of user to process.
+17 ; TIUTMP = Call return array values holder.
+18 ; TIUTPLT = Template IEN.
+19 ; X,Y = Variables for FM call.
+20 ;
+21 QUIT
+22 ;
SELUSR ; Call here for manual selection of TIUSR from NEW PERSON file.
+1 ;
+2 NEW DIR,TIUCNT,TIUGET,TIUIDX,TIUNM,TIUNUM,TIUTPLT,TIURARY,TIUSR,X,Y
+3 ;
+4 ; Get input for user:
+5 ; Default.
SET TIUSR=""
+6 SET DIR(0)="PAO^200,:AEMNQ"
+7 SET DIR("A")=" Enter/select user for whom templates will be deleted: "
+8 SET DIR("?")="Specify user for template cleanup."
+9 DO ^DIR
+10 SET TIUSR=Y
+11 ; Clean up from FM call.
KILL DIR,X,Y
+12 ; No acceptable entry.
IF TIUSR<1
SET TIUSR=""
QUIT
+13 ; Selected user's DUZ.
SET TIUSR=+TIUSR
+14 ; Punt here if there's a problem.
IF TIUSR=""
QUIT
+15 ;
+16 ; Confirm before deletion:
+17 SET TIUNM=$PIECE($GET(^VA(200,TIUSR,0)),U,1)
+18 ; Two minute maximum timeout for response.
SET DIR("T")=120
+19 SET DIR("A")=" Delete all non-shared templates for user "_TIUNM_" (Y/N)"
+20 SET DIR("?")=" Non-shared templates for this user will be permanently lost..."
+21 ; Default.
SET DIR("B")="NO"
+22 ;
+23 ; Define DIR input requirements:
+24 SET DIR(0)="YO^1:2:0"
+25 ;
+26 ; Call DIR for user choice:
+27 ; Spacing for screen display.
WRITE !!
+28 DO ^DIR
+29 ;
+30 ; Check user response:
+31 ; Skip if Y isn't assigned.
IF '$LENGTH($GET(Y))
QUIT
+32 ; Skip if Y is null.
IF Y=""
QUIT
+33 ; Skip if Y is "^" character.
IF Y="^"
QUIT
+34 ; Skip if Y is less than one.
IF Y<1
QUIT
+35 ; "No" choice.
IF Y>2
QUIT
+36 ; Clean up from FM call.
KILL DIR,X,Y
+37 ;
+38 ; Proceed with clean up:
+39 DO CTRL
+40 ; Array not returned under manual functionality.
KILL TIURARY
+41 ;
+42 QUIT
+43 ;
KUSER ; Get USER from Kernel - called by option: TIU TEMPLATE USER DELETE.
+1 ;
+2 ; See if this function is "active" by checking Parameter:
+3 ;
+4 NEW TIUCNT,TIUGET,TIUIDX,TIUNUM,TIUTPLT,TIUPAR,TIURARY,TIUSR
+5 SET TIUPAR=$$GET^XPAR("DIV^SYS^PKG","TIU TEMPLATE USER AUTO DELETE",1,"E")
+6 IF TIUPAR'="YES"
QUIT
+7 IF TIUPAR=""
QUIT
+8 ;
+9 ; Parameter set to activate auto-cleanup - proceed:
+10 ; Assign TIUSR variable.
SET TIUSR=$GET(XUIFN)
+11 ; Punt here if there's a problem.
IF TIUSR=""
QUIT
+12 DO CTRL
+13 ; Array not returned when triggered by Kernel.
KILL TIURARY
+14 ;
+15 QUIT
+16 ;
CLEAN(TIUSR,TIURARY) ; Call here as an RPC: Dump templates for one user.
+1 ;
+2 NEW TIUCNT,TIUGET,TIUIDX,TIUNUM,TIUTPLT
+3 IF 'TIUSR>0
SET TIURARY(0)="No user DUZ passed."
QUIT
+4 ;
CTRL ; Main control code for actual cleanup process.
+1 ;
+2 SET TIUCNT=0
+3 ;
+4 ; See if there is an AROOT x-ref entry for this user:
+5 IF '$DATA(^TIU(8927,"AROOT",TIUSR))
SET TIURARY(0)="No AROOT record."
QUIT
+6 ;
+7 ; Get parent record for user's templates:
+8 SET TIUTPLT=0
+9 FOR
Begin DoDot:1
+10 SET TIUTPLT=$ORDER(^TIU(8927,"AROOT",TIUSR,TIUTPLT))
+11 IF 'TIUTPLT
QUIT
+12 ;
+13 ; Compile an array of applicable templates:
+14 DO DEL(TIUTPLT)
End DoDot:1
if 'TIUTPLT
QUIT
+15 ;
+16 QUIT
+17 ;
DEL(TIUIEN) ; Pass root node of AROOT x-ref of <^TIU(8927,> file.
+1 ;
+2 NEW TIUARY,TIUTMP
+3 ;
+4 ; 0-node: "UserDUZ^ARootIEN" format.
SET TIURARY(TIUCNT)=TIUSR_U_TIUIEN
+5 ; Recursive array builder.
DO BLD(TIUIEN,.TIUARY)
+6 ;
+7 ; Create or add to return array:
+8 SET (TIUGET,TIUNUM)=0
+9 FOR
Begin DoDot:1
+10 SET TIUNUM=TIUNUM+1
+11 SET TIUGET=$GET(TIUARY(TIUNUM))
+12 IF 'TIUGET
QUIT
+13 SET TIUCNT=TIUCNT+1
+14 SET TIURARY(TIUCNT)=TIUGET
End DoDot:1
if 'TIUGET
QUIT
+15 ;
+16 ; Using the array of templates, make call that kills only orphans:
+17 DO DELETE^TIUSRVT(.TIUTMP,.TIUARY)
+18 ;
+19 QUIT
+20 ;
BLD(TIUIEN,TIUARY) ; Recursively build an array of templates.
+1 ;
+2 NEW TIUIDX
+3 ;
+4 SET TIUIDX=$ORDER(TIUARY(" "),-1)+1
+5 SET TIUARY(TIUIDX)=TIUIEN
+6 SET TIUIDX=0
+7 FOR
SET TIUIDX=$ORDER(^TIU(8927,TIUIEN,10,TIUIDX))
if 'TIUIDX
QUIT
Begin DoDot:1
+8 DO BLD($PIECE(^TIU(8927,TIUIEN,10,TIUIDX,0),U,2),.TIUARY)
End DoDot:1
+9 ;
+10 QUIT
+11 ;
