XUSMGR ;SF-ISC/STAFF - SECURITY UTILITIES ROUTINE ; 7/15/03 7:03am
;;8.0;KERNEL;**263,258,314**;Jul 10, 1995
W !!,"Use the MENU system",!! Q
X1 ;Old intro test edit
N DIE,DA,DR
W !!,"Please use menu option 'Inrtoductory text edit'" H 4 ;Sign-on intro text.
S DIE="^XTV(8989.3,",DA=1,DR=240 D ^DIE Q
;
X6 ;Clear Terminal
N %ZIS
S %ZIS="QN" D ^%ZIS G:POP EX6 I '$D(^DISV("XU",IOS)) W !!,$C(7),"Terminal does not need to be cleared!!!",! G X6
K ^DISV("XU",IOS),%ZIS W !,"Terminal has been CLEARED!!",!
EX6 D HOME^%ZIS Q
;
X8 ;Release user
N DIC,DIR,J,X,Y,FDA,IEN,X1,X2,X3
X8A W !!,"This will clear the user from the list of currently sign-on users."
W !,"And/or release from invalid sign on lock."
S DIC="^VA(200,",DIC(0)="AEMQ" D ^DIC S IEN=+Y G:Y<1 EX8
S (X1,X2,X3)=0
I $P($G(^VA(200,IEN,1.1)),"^",3) S X1=1
I $P($G(^VA(200,IEN,1.1)),"^",5) S X2=1
I $D(^XUSEC(0,"CUR",IEN)) S X3=1
I '(X1+X2+X3) D G X8
. W !!,$C(7),"User is not currently recorded as being signed on the system!!!",!
;Show user info
W !,"User: ",$P(Y,U,2)," is listed with the following connections."
S J=0 F S J=$O(^XUSEC(0,"CUR",IEN,J)) Q:J'>0 D
. I '$D(^XUSEC(0,J,0)) K ^XUSEC(0,"CUR",IEN,J) Q
. S X=^XUSEC(0,J,0)
. W !,"Connected: ",$$FMTE^XLFDT(J,"1"),?39," Device: ",$P(X,U,2)
. W !,?2," Node: ",$P(X,U,10),?39," IP: ",$S($L($P(X,U,11)):$P(X,U,11),1:$P(X,U,12))
. Q
I $P(^VA(200,IEN,1.1),U,5) W !,"Locked out until ",$$FMTE^XLFDT($P(^VA(200,IEN,1.1),U,5))," because of too many invalid attempts."
;
S DIR(0)="Y",DIR("A")="Release this user",DIR("B")="Yes" D ^DIR
I 'Y G X8A
S $P(^VA(200,IEN,1.1),"^",3)=0,$P(^VA(200,IEN,1.1),U,5)="" ;Clear flag,Lockout time
S J=0 F S J=$O(^XUSEC(0,"CUR",IEN,J)) Q:J'>0 D
. S FDA(3.081,J_",",3)=$$NOW^XLFDT,FDA(3.081,J_",",16)=1 D UPDATE^DIE("","FDA")
W !,"User is RELEASED!!",!
EX8 Q
;
SCPURG ;Purge sign-on log
S XUDT=$$HTFM^XLFDT($H-30) I $O(^XUSEC(0,0))'>0 G SCEXIT
S DIK="^XUSEC(0," F DA=0:0 S DA=$O(^XUSEC(0,DA)) Q:(DA'>0)!(DA>XUDT) D ^DIK
SCEXIT K DIK,DA,XUDT,X1,X2 Q
IXKEY ;Re-Index the New Person file Key sub-file
N DA,DIK,ACT
W:'$D(ZTQUEUED) !,"Starting"
;we only want to reindex the "AC" x-ref
S DIK(1)=".01^AC"
;loop through New Person file and index entries
F DA(1)=0:0 S DA(1)=$O(^VA(200,DA(1))) Q:DA(1)'>0 D
.;skip inactive person
.;Q:$P($G(^VA(200,DA(1),0)),"^",11)
.S ACT=+$$ACTIVE^XUSER(DA(1))
.I ACT'=1 Q
.;global root for multiple
.S DIK="^VA(200,DA(1),51,"
.;reindex
.D ENALL^DIK W:'(DA(1)#50) "."
.;
W:'$D(ZTQUEUED) !,"Done"
;
;the old codes
;W:'$D(ZTQUEUED) !,"Starting "
;S DIK="^VA(200,DA(1),51,",DIK(1)=".01^1^2^3^4"
;F DA(1)=0:0 S DA(1)=$O(^VA(200,DA(1))) Q:DA(1)'>0 D ENALL^DIK W:'(DA(1)#50) "."
;W:'$D(ZTQUEUED) !,"Done"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUSMGR 2804 printed Apr 09, 2024@21:06:41 Page 2
XUSMGR ;SF-ISC/STAFF - SECURITY UTILITIES ROUTINE ; 7/15/03 7:03am
+1 ;;8.0;KERNEL;**263,258,314**;Jul 10, 1995
+2 WRITE !!,"Use the MENU system",!!
QUIT
X1 ;Old intro test edit
+1 NEW DIE,DA,DR
+2 ;Sign-on intro text.
WRITE !!,"Please use menu option 'Inrtoductory text edit'"
HANG 4
+3 SET DIE="^XTV(8989.3,"
SET DA=1
SET DR=240
DO ^DIE
QUIT
+4 ;
X6 ;Clear Terminal
+1 NEW %ZIS
+2 SET %ZIS="QN"
DO ^%ZIS
if POP
GOTO EX6
IF '$DATA(^DISV("XU",IOS))
WRITE !!,$CHAR(7),"Terminal does not need to be cleared!!!",!
GOTO X6
+3 KILL ^DISV("XU",IOS),%ZIS
WRITE !,"Terminal has been CLEARED!!",!
EX6 DO HOME^%ZIS
QUIT
+1 ;
X8 ;Release user
+1 NEW DIC,DIR,J,X,Y,FDA,IEN,X1,X2,X3
X8A WRITE !!,"This will clear the user from the list of currently sign-on users."
+1 WRITE !,"And/or release from invalid sign on lock."
+2 SET DIC="^VA(200,"
SET DIC(0)="AEMQ"
DO ^DIC
SET IEN=+Y
if Y<1
GOTO EX8
+3 SET (X1,X2,X3)=0
+4 IF $PIECE($GET(^VA(200,IEN,1.1)),"^",3)
SET X1=1
+5 IF $PIECE($GET(^VA(200,IEN,1.1)),"^",5)
SET X2=1
+6 IF $DATA(^XUSEC(0,"CUR",IEN))
SET X3=1
+7 IF '(X1+X2+X3)
Begin DoDot:1
+8 WRITE !!,$CHAR(7),"User is not currently recorded as being signed on the system!!!",!
End DoDot:1
GOTO X8
+9 ;Show user info
+10 WRITE !,"User: ",$PIECE(Y,U,2)," is listed with the following connections."
+11 SET J=0
FOR
SET J=$ORDER(^XUSEC(0,"CUR",IEN,J))
if J'>0
QUIT
Begin DoDot:1
+12 IF '$DATA(^XUSEC(0,J,0))
KILL ^XUSEC(0,"CUR",IEN,J)
QUIT
+13 SET X=^XUSEC(0,J,0)
+14 WRITE !,"Connected: ",$$FMTE^XLFDT(J,"1"),?39," Device: ",$PIECE(X,U,2)
+15 WRITE !,?2," Node: ",$PIECE(X,U,10),?39," IP: ",$SELECT($LENGTH($PIECE(X,U,11)):$PIECE(X,U,11),1:$PIECE(X,U,12))
+16 QUIT
End DoDot:1
+17 IF $PIECE(^VA(200,IEN,1.1),U,5)
WRITE !,"Locked out until ",$$FMTE^XLFDT($PIECE(^VA(200,IEN,1.1),U,5))," because of too many invalid attempts."
+18 ;
+19 SET DIR(0)="Y"
SET DIR("A")="Release this user"
SET DIR("B")="Yes"
DO ^DIR
+20 IF 'Y
GOTO X8A
+21 ;Clear flag,Lockout time
SET $PIECE(^VA(200,IEN,1.1),"^",3)=0
SET $PIECE(^VA(200,IEN,1.1),U,5)=""
+22 SET J=0
FOR
SET J=$ORDER(^XUSEC(0,"CUR",IEN,J))
if J'>0
QUIT
Begin DoDot:1
+23 SET FDA(3.081,J_",",3)=$$NOW^XLFDT
SET FDA(3.081,J_",",16)=1
DO UPDATE^DIE("","FDA")
End DoDot:1
+24 WRITE !,"User is RELEASED!!",!
EX8 QUIT
+1 ;
SCPURG ;Purge sign-on log
+1 SET XUDT=$$HTFM^XLFDT($HOROLOG-30)
IF $ORDER(^XUSEC(0,0))'>0
GOTO SCEXIT
+2 SET DIK="^XUSEC(0,"
FOR DA=0:0
SET DA=$ORDER(^XUSEC(0,DA))
if (DA'>0)!(DA>XUDT)
QUIT
DO ^DIK
SCEXIT KILL DIK,DA,XUDT,X1,X2
QUIT
IXKEY ;Re-Index the New Person file Key sub-file
+1 NEW DA,DIK,ACT
+2 if '$DATA(ZTQUEUED)
WRITE !,"Starting"
+3 ;we only want to reindex the "AC" x-ref
+4 SET DIK(1)=".01^AC"
+5 ;loop through New Person file and index entries
+6 FOR DA(1)=0:0
SET DA(1)=$ORDER(^VA(200,DA(1)))
if DA(1)'>0
QUIT
Begin DoDot:1
+7 ;skip inactive person
+8 ;Q:$P($G(^VA(200,DA(1),0)),"^",11)
+9 SET ACT=+$$ACTIVE^XUSER(DA(1))
+10 IF ACT'=1
QUIT
+11 ;global root for multiple
+12 SET DIK="^VA(200,DA(1),51,"
+13 ;reindex
+14 DO ENALL^DIK
if '(DA(1)#50)
WRITE "."
+15 ;
End DoDot:1
+16 if '$DATA(ZTQUEUED)
WRITE !,"Done"
+17 ;
+18 ;the old codes
+19 ;W:'$D(ZTQUEUED) !,"Starting "
+20 ;S DIK="^VA(200,DA(1),51,",DIK(1)=".01^1^2^3^4"
+21 ;F DA(1)=0:0 S DA(1)=$O(^VA(200,DA(1))) Q:DA(1)'>0 D ENALL^DIK W:'(DA(1)#50) "."
+22 ;W:'$D(ZTQUEUED) !,"Done"
+23 QUIT
