AZAXSKK ;IHS/PHXAO/AEF - REPAIR SECURITY KEYS
;;1.0;PHXAO UTILITY ROUTINES;;MAR 19, 2009
;
DESC ;----- ROUTINE DESCRIPTION
;;This routine will remove keys assigned to users before the
;;specified date.
;;It will then remove the keys contained in the ^XUSEC
;;global and rebuild the ^XUSEC global based on the
;;keys belonging to users in the New Person file #200.
;;
;;It is recommended that you obtain a backup copy of the
;;^XUSEC global before running this routine.
;;
;;$$END
;
N I,X F I=1:1 S X=$T(DESC+I) Q:X["$$END" D EN^DDIOL($P(X,";;",2))
Q
EN ;EP -- MAIN ENTRY POINT
;
N DATE,OUT
;
D ^XBKVAR
D HOME^%ZIS
;
S OUT=0
S DATE=""
D DESC
D PAWS(.OUT)
Q:OUT
D DATE(.DATE)
Q:'DATE
D USR(DATE)
Q:OUT
D KILL
D RBLD
Q
USR(DATE) ;
;----- REMOVE OLD KEYS FROM USERS
;
N CNT,D0
;
D EN^DDIOL("REMOVING OLD KEYS FROM USERS...")
;
S CNT=0
S D0=0
F S D0=$O(^VA(200,D0)) Q:'D0 D
. D USR1(D0,DATE,.CNT)
Q
USR1(D0,DATE,CNT) ;
;----- REMOVE OLD KEYS FROM ONE USER
;
N D1,DA,DIK,X,Y
;
S D1=0
F S D1=$O(^VA(200,D0,51,D1)) Q:'D1 D
. S CNT=$G(CNT)+1
. W:'(CNT#100) "."
. Q:$P($G(^VA(200,D0,51,D1,0)),U,3)>DATE
. S DA=D1
. S DA(1)=D0
. S DIK="^VA(200,"_DA(1)_",51,"
. D ^DIK
Q
KILL ;----- KILL KEYS IN ^XUSEC GLOBAL
;
N X
;
D EN^DDIOL("REMOVING KEYS FROM ^XUSEC GLOBAL...")
S X="A"
F S X=$O(^XUSEC(X)) Q:X']"" D
. K ^XUSEC(X)
Q
RBLD ;----- REBUILD ^XUSEC GLOBAL
;
D EN^DDIOL("REBUILDING ^XUSEC GLOBAL...")
D IXKEY^XUSMGR
Q
PAWS(OUT) ;
;----- ISSUE 'RETURN' PROMPT
;
N DIR,X,Y
S OUT=0
I $E($G(IOST))="C" D
. W !
. S DIR(0)="E"
. D ^DIR
. I 'Y S OUT=1
Q
DATE(DATE) ;
;----- ASK WHICH DATE
;
N DIR,DIRUT,DTOUT,DUOUT,X,Y
;
S DATE=""
D EN^DDIOL("","","!")
S DIR(0)="DO^::E"
S DIR("A")="Delete keys assigned before which DATE"
S DIR("?")="Enter a date or '^' to quit."
D ^DIR
Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))
Q:Y=""
S DATE=Y
Q
AZAXSKK ;IHS/PHXAO/AEF - REPAIR SECURITY KEYS
+1 ;;1.0;PHXAO UTILITY ROUTINES;;MAR 19, 2009
+2 ;
DESC ;----- ROUTINE DESCRIPTION
+1 ;;This routine will remove keys assigned to users before the
+2 ;;specified date.
+3 ;;It will then remove the keys contained in the ^XUSEC
+4 ;;global and rebuild the ^XUSEC global based on the
+5 ;;keys belonging to users in the New Person file #200.
+6 ;;
+7 ;;It is recommended that you obtain a backup copy of the
+8 ;;^XUSEC global before running this routine.
+9 ;;
+10 ;;$$END
+11 ;
+12 NEW I,X
FOR I=1:1
SET X=$TEXT(DESC+I)
IF X["$$END"
QUIT
DO EN^DDIOL($PIECE(X,";;",2))
+13 QUIT
EN ;EP -- MAIN ENTRY POINT
+1 ;
+2 NEW DATE,OUT
+3 ;
+4 DO ^XBKVAR
+5 DO HOME^%ZIS
+6 ;
+7 SET OUT=0
+8 SET DATE=""
+9 DO DESC
+10 DO PAWS(.OUT)
+11 IF OUT
QUIT
+12 DO DATE(.DATE)
+13 IF 'DATE
QUIT
+14 DO USR(DATE)
+15 IF OUT
QUIT
+16 DO KILL
+17 DO RBLD
+18 QUIT
USR(DATE) ;
+1 ;----- REMOVE OLD KEYS FROM USERS
+2 ;
+3 NEW CNT,D0
+4 ;
+5 DO EN^DDIOL("REMOVING OLD KEYS FROM USERS...")
+6 ;
+7 SET CNT=0
+8 SET D0=0
+9 FOR
SET D0=$ORDER(^VA(200,D0))
IF 'D0
QUIT
Begin DoDot:1
+10 DO USR1(D0,DATE,.CNT)
End DoDot:1
+11 QUIT
USR1(D0,DATE,CNT) ;
+1 ;----- REMOVE OLD KEYS FROM ONE USER
+2 ;
+3 NEW D1,DA,DIK,X,Y
+4 ;
+5 SET D1=0
+6 FOR
SET D1=$ORDER(^VA(200,D0,51,D1))
IF 'D1
QUIT
Begin DoDot:1
+7 SET CNT=$GET(CNT)+1
+8 IF '(CNT#100)
WRITE "."
+9 IF $PIECE($GET(^VA(200,D0,51,D1,0)),U,3)>DATE
QUIT
+10 SET DA=D1
+11 SET DA(1)=D0
+12 SET DIK="^VA(200,"_DA(1)_",51,"
+13 DO ^DIK
End DoDot:1
+14 QUIT
KILL ;----- KILL KEYS IN ^XUSEC GLOBAL
+1 ;
+2 NEW X
+3 ;
+4 DO EN^DDIOL("REMOVING KEYS FROM ^XUSEC GLOBAL...")
+5 SET X="A"
+6 FOR
SET X=$ORDER(^XUSEC(X))
IF X']""
QUIT
Begin DoDot:1
+7 KILL ^XUSEC(X)
End DoDot:1
+8 QUIT
RBLD ;----- REBUILD ^XUSEC GLOBAL
+1 ;
+2 DO EN^DDIOL("REBUILDING ^XUSEC GLOBAL...")
+3 DO IXKEY^XUSMGR
+4 QUIT
PAWS(OUT) ;
+1 ;----- ISSUE 'RETURN' PROMPT
+2 ;
+3 NEW DIR,X,Y
+4 SET OUT=0
+5 IF $EXTRACT($GET(IOST))="C"
Begin DoDot:1
+6 WRITE !
+7 SET DIR(0)="E"
+8 DO ^DIR
+9 IF 'Y
SET OUT=1
End DoDot:1
+10 QUIT
DATE(DATE) ;
+1 ;----- ASK WHICH DATE
+2 ;
+3 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+4 ;
+5 SET DATE=""
+6 DO EN^DDIOL("","","!")
+7 SET DIR(0)="DO^::E"
+8 SET DIR("A")="Delete keys assigned before which DATE"
+9 SET DIR("?")="Enter a date or '^' to quit."
+10 DO ^DIR
+11 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))
QUIT
+12 IF Y=""
QUIT
+13 SET DATE=Y
+14 QUIT
