TIUSRVT4.m

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 ---TIUSRVT4   3432     printed  Mar 13, 2025@21:51:03                                                                                                                                                                                                    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      ;