Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIUSRVT3

TIUSRVT3.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ; Variables used herein:
  1. ;
  1. ; DIR = FM call varible.
  1. ; TIUARY = Array holder.
  1. ; TIUCNT = Returned array counter.
  1. ; TIUGET = Holder for returned array $O command.
  1. ; TIUIDX = X-ref holder.
  1. ; TIUIEN = Template IEN holder.
  1. ; TIUNM = Holder variable for name of user.
  1. ; TIUNUM = Loop counter from this routine.
  1. ; TIUPAR = Current setting of auto-cleanup parameter.
  1. ; TIURARY = Returned array; zero node will contain user's DUZ and
  1. ; AROOT IEN (if any) or error message (RPC use only).
  1. ; TIUSR = DUZ of user to process.
  1. ; TIUTMP = Call return array values holder.
  1. ; TIUTPLT = Template IEN.
  1. ; X,Y = Variables for FM call.
  1. ;
  1. Q
  1. ;
  1. SELUSR ; Call here for manual selection of TIUSR from NEW PERSON file.
  1. ;
  1. N DIR,TIUCNT,TIUGET,TIUIDX,TIUNM,TIUNUM,TIUTPLT,TIURARY,TIUSR,X,Y
  1. ;
  1. ; Get input for user:
  1. S TIUSR="" ; Default.
  1. S DIR(0)="PAO^200,:AEMNQ"
  1. S DIR("A")=" Enter/select user for whom templates will be deleted: "
  1. S DIR("?")="Specify user for template cleanup."
  1. D ^DIR
  1. S TIUSR=Y
  1. K DIR,X,Y ; Clean up from FM call.
  1. I TIUSR<1 S TIUSR="" Q ; No acceptable entry.
  1. S TIUSR=+TIUSR ; Selected user's DUZ.
  1. I TIUSR="" Q ; Punt here if there's a problem.
  1. ;
  1. ; Confirm before deletion:
  1. S TIUNM=$P($G(^VA(200,TIUSR,0)),U,1)
  1. S DIR("T")=120 ; Two minute maximum timeout for response.
  1. S DIR("A")=" Delete all non-shared templates for user "_TIUNM_" (Y/N)"
  1. S DIR("?")=" Non-shared templates for this user will be permanently lost..."
  1. S DIR("B")="NO" ; Default.
  1. ;
  1. ; Define DIR input requirements:
  1. S DIR(0)="YO^1:2:0"
  1. ;
  1. ; Call DIR for user choice:
  1. W !! ; Spacing for screen display.
  1. D ^DIR
  1. ;
  1. ; Check user response:
  1. I '$L($G(Y)) Q ; Skip if Y isn't assigned.
  1. I Y="" Q ; Skip if Y is null.
  1. I Y="^" Q ; Skip if Y is "^" character.
  1. I Y<1 Q ; Skip if Y is less than one.
  1. I Y>2 Q ; "No" choice.
  1. K DIR,X,Y ; Clean up from FM call.
  1. ;
  1. ; Proceed with clean up:
  1. D CTRL
  1. K TIURARY ; Array not returned under manual functionality.
  1. ;
  1. Q
  1. ;
  1. KUSER ; Get USER from Kernel - called by option: TIU TEMPLATE USER DELETE.
  1. ;
  1. ; See if this function is "active" by checking Parameter:
  1. ;
  1. N TIUCNT,TIUGET,TIUIDX,TIUNUM,TIUTPLT,TIUPAR,TIURARY,TIUSR
  1. S TIUPAR=$$GET^XPAR("DIV^SYS^PKG","TIU TEMPLATE USER AUTO DELETE",1,"E")
  1. I TIUPAR'="YES" Q
  1. I TIUPAR="" Q
  1. ;
  1. ; Parameter set to activate auto-cleanup - proceed:
  1. S TIUSR=$GET(XUIFN) ; Assign TIUSR variable.
  1. I TIUSR="" Q ; Punt here if there's a problem.
  1. D CTRL
  1. K TIURARY ; Array not returned when triggered by Kernel.
  1. ;
  1. Q
  1. ;
  1. CLEAN(TIUSR,TIURARY) ; Call here as an RPC: Dump templates for one user.
  1. ;
  1. N TIUCNT,TIUGET,TIUIDX,TIUNUM,TIUTPLT
  1. I 'TIUSR>0 S TIURARY(0)="No user DUZ passed." Q
  1. ;
  1. CTRL ; Main control code for actual cleanup process.
  1. ;
  1. S TIUCNT=0
  1. ;
  1. ; See if there is an AROOT x-ref entry for this user:
  1. I '$D(^TIU(8927,"AROOT",TIUSR)) S TIURARY(0)="No AROOT record." Q
  1. ;
  1. ; Get parent record for user's templates:
  1. S TIUTPLT=0
  1. F D Q:'TIUTPLT
  1. .S TIUTPLT=$O(^TIU(8927,"AROOT",TIUSR,TIUTPLT))
  1. .I 'TIUTPLT Q
  1. .;
  1. .; Compile an array of applicable templates:
  1. .D DEL(TIUTPLT)
  1. ;
  1. Q
  1. ;
  1. DEL(TIUIEN) ; Pass root node of AROOT x-ref of <^TIU(8927,> file.
  1. ;
  1. N TIUARY,TIUTMP
  1. ;
  1. S TIURARY(TIUCNT)=TIUSR_U_TIUIEN ; 0-node: "UserDUZ^ARootIEN" format.
  1. D BLD(TIUIEN,.TIUARY) ; Recursive array builder.
  1. ;
  1. ; Create or add to return array:
  1. S (TIUGET,TIUNUM)=0
  1. F D Q:'TIUGET
  1. .S TIUNUM=TIUNUM+1
  1. .S TIUGET=$G(TIUARY(TIUNUM))
  1. .I 'TIUGET Q
  1. .S TIUCNT=TIUCNT+1
  1. .S TIURARY(TIUCNT)=TIUGET
  1. ;
  1. ; Using the array of templates, make call that kills only orphans:
  1. D DELETE^TIUSRVT(.TIUTMP,.TIUARY)
  1. ;
  1. Q
  1. ;
  1. BLD(TIUIEN,TIUARY) ; Recursively build an array of templates.
  1. ;
  1. N TIUIDX
  1. ;
  1. S TIUIDX=$O(TIUARY(" "),-1)+1
  1. S TIUARY(TIUIDX)=TIUIEN
  1. S TIUIDX=0
  1. F S TIUIDX=$O(^TIU(8927,TIUIEN,10,TIUIDX)) Q:'TIUIDX D
  1. .D BLD($P(^TIU(8927,TIUIEN,10,TIUIDX,0),U,2),.TIUARY)
  1. ;
  1. Q
  1. ;