- 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 Feb 19, 2025@00:12:37 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 ;