TIUSRVT4 ; SLC/PKS Remove all terminated user Templates. ; [3/15/01 12:15pm]
;;1.0;TEXT INTEGRATION UTILITIES;**110**;Jun 20, 1997
;
; Variables used herein:
;
; TIUANS = Result of call to $$VERIF.
; TIUARY = Array holder.
; TIUCNT = Counter Variable.
; TIUERR = Error array for call return.
; TIUIDX = X-ref holder.
; TIUIEN = Template IEN holder.
; TIUNOW = Current date.
; TIUNUM = Loop counter.
; TIUSR = Terminated user (DUZ).
; TIUSTAT = Status of user.
; TIUTMP = Call return array value holder.
; TIUTPLT = Template IEN.
;
Q
;
CTRL ; Main control section.
;
N TIUANS,TIUCNT,TIUERR,TIUIDX,TIUNOW,TIUSR,TIUSTAT,TIUTPLT
;
S TIUANS=$$VERIF ; Confirm before deleting.
I 'TIUANS Q ; User failed to confirm - quit.
;
D EACH ; Call to process template cleanup.
;
Q
;
EACH ; Process template deletion for each user found who has any.
;
; Get current date information:
D NOW^%DTC
S TIUNOW=X
K X
;
; Retrieve each user in ^TIU(8927 file:
S TIUSR=0
F D Q:'TIUSR
.S TIUSR=$O(^TIU(8927,"AROOT",TIUSR))
.I 'TIUSR Q
.;
.; Check user's status - look for terminated users:
.I '$D(^VA(200,TIUSR,0)) Q ; No user record.
.I '$L($P($G(^VA(200,TIUSR,0)),"^",1)) Q ; Invalid user data.
.S TIUSTAT=$$GET1^DIQ(200,TIUSR,9.2,"I",,.TIUERR) ; Termination date?
.I 'TIUSTAT Q ; Active user.
.I TIUSTAT>TIUNOW Q ; User terminated on a future date.
.;
.; User terminated, effective today or earlier, so proceed:
.; Find AROOT x-ref record, if any:
.S TIUTPLT=0
.F D Q:'TIUTPLT
..S TIUTPLT=$O(^TIU(8927,"AROOT",TIUSR,TIUTPLT))
..I 'TIUTPLT Q
..;
..; Get any existing templates, delete them:
..D DEL(TIUTPLT)
;
Q
;
DEL(TIUIEN) ; Pass root node of AROOT x-ref.
;
N TIUARY,TIUNUM,TIUTMP
;
D BLD(TIUIEN,.TIUARY) ; Recursive call.
;
D DELETE^TIUSRVT(.TIUTMP,.TIUARY) ; Kill record(s).
;
Q
;
BLD(TIUIEN,TIUARY) ; Build array of templates for user.
;
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
;
PARSET ; Edit parameter for auto-cleanup of templates upon termination.
;
D EDITPAR^XPAREDIT("TIU TEMPLATE USER AUTO DELETE")
;
Q
;
VERIF() ; Verify that user really wants to execute this option:
;
N DIR,X,Y ; DIR variables.
S DIR("T")=120 ; Two minute maximum timeout for response.
S DIR("A")=" Delete all non-shared templates for all terminated users (Y/N)"
S DIR("?")=" Templates for terminated users 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 0 ; Skip if Y isn't assigned.
I Y="" Q 0 ; Skip if Y is null.
I Y="^" Q 0 ; Skip if Y is "^" character.
I Y<1 Q 0 ; Skip if Y is less than one.
I Y>2 Q 0 ; "No" choice.
I Y=1 Q 1 ; "Yes" choice.
;
Q 0 ; Default return of "No."
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUSRVT4 3432 printed Dec 13, 2024@02:46:09 Page 2
TIUSRVT4 ; SLC/PKS Remove all terminated user Templates. ; [3/15/01 12:15pm]
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**110**;Jun 20, 1997
+2 ;
+3 ; Variables used herein:
+4 ;
+5 ; TIUANS = Result of call to $$VERIF.
+6 ; TIUARY = Array holder.
+7 ; TIUCNT = Counter Variable.
+8 ; TIUERR = Error array for call return.
+9 ; TIUIDX = X-ref holder.
+10 ; TIUIEN = Template IEN holder.
+11 ; TIUNOW = Current date.
+12 ; TIUNUM = Loop counter.
+13 ; TIUSR = Terminated user (DUZ).
+14 ; TIUSTAT = Status of user.
+15 ; TIUTMP = Call return array value holder.
+16 ; TIUTPLT = Template IEN.
+17 ;
+18 QUIT
+19 ;
CTRL ; Main control section.
+1 ;
+2 NEW TIUANS,TIUCNT,TIUERR,TIUIDX,TIUNOW,TIUSR,TIUSTAT,TIUTPLT
+3 ;
+4 ; Confirm before deleting.
SET TIUANS=$$VERIF
+5 ; User failed to confirm - quit.
IF 'TIUANS
QUIT
+6 ;
+7 ; Call to process template cleanup.
DO EACH
+8 ;
+9 QUIT
+10 ;
EACH ; Process template deletion for each user found who has any.
+1 ;
+2 ; Get current date information:
+3 DO NOW^%DTC
+4 SET TIUNOW=X
+5 KILL X
+6 ;
+7 ; Retrieve each user in ^TIU(8927 file:
+8 SET TIUSR=0
+9 FOR
Begin DoDot:1
+10 SET TIUSR=$ORDER(^TIU(8927,"AROOT",TIUSR))
+11 IF 'TIUSR
QUIT
+12 ;
+13 ; Check user's status - look for terminated users:
+14 ; No user record.
IF '$DATA(^VA(200,TIUSR,0))
QUIT
+15 ; Invalid user data.
IF '$LENGTH($PIECE($GET(^VA(200,TIUSR,0)),"^",1))
QUIT
+16 ; Termination date?
SET TIUSTAT=$$GET1^DIQ(200,TIUSR,9.2,"I",,.TIUERR)
+17 ; Active user.
IF 'TIUSTAT
QUIT
+18 ; User terminated on a future date.
IF TIUSTAT>TIUNOW
QUIT
+19 ;
+20 ; User terminated, effective today or earlier, so proceed:
+21 ; Find AROOT x-ref record, if any:
+22 SET TIUTPLT=0
+23 FOR
Begin DoDot:2
+24 SET TIUTPLT=$ORDER(^TIU(8927,"AROOT",TIUSR,TIUTPLT))
+25 IF 'TIUTPLT
QUIT
+26 ;
+27 ; Get any existing templates, delete them:
+28 DO DEL(TIUTPLT)
End DoDot:2
if 'TIUTPLT
QUIT
End DoDot:1
if 'TIUSR
QUIT
+29 ;
+30 QUIT
+31 ;
DEL(TIUIEN) ; Pass root node of AROOT x-ref.
+1 ;
+2 NEW TIUARY,TIUNUM,TIUTMP
+3 ;
+4 ; Recursive call.
DO BLD(TIUIEN,.TIUARY)
+5 ;
+6 ; Kill record(s).
DO DELETE^TIUSRVT(.TIUTMP,.TIUARY)
+7 ;
+8 QUIT
+9 ;
BLD(TIUIEN,TIUARY) ; Build array of templates for user.
+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 ;
PARSET ; Edit parameter for auto-cleanup of templates upon termination.
+1 ;
+2 DO EDITPAR^XPAREDIT("TIU TEMPLATE USER AUTO DELETE")
+3 ;
+4 QUIT
+5 ;
VERIF() ; Verify that user really wants to execute this option:
+1 ;
+2 ; DIR variables.
NEW DIR,X,Y
+3 ; Two minute maximum timeout for response.
SET DIR("T")=120
+4 SET DIR("A")=" Delete all non-shared templates for all terminated users (Y/N)"
+5 SET DIR("?")=" Templates for terminated users will be permanently lost..."
+6 ; Default.
SET DIR("B")="NO"
+7 ;
+8 ; Define DIR input requirements:
+9 SET DIR(0)="YO^1:2:0"
+10 ;
+11 ; Call DIR for user choice:
+12 ; Spacing for screen display.
WRITE !!
+13 DO ^DIR
+14 ;
+15 ; Check user response:
+16 ; Skip if Y isn't assigned.
IF '$LENGTH($GET(Y))
QUIT 0
+17 ; Skip if Y is null.
IF Y=""
QUIT 0
+18 ; Skip if Y is "^" character.
IF Y="^"
QUIT 0
+19 ; Skip if Y is less than one.
IF Y<1
QUIT 0
+20 ; "No" choice.
IF Y>2
QUIT 0
+21 ; "Yes" choice.
IF Y=1
QUIT 1
+22 ;
+23 ; Default return of "No."
QUIT 0
+24 ;
