XUFILE3 ;SF-ISC/STAFF - FILE ACCESS CONTROL FOR KERNEL V8 ;07/26/94 16:24
;;8.0;KERNEL;;Jul 10, 1995
Q
DISABLE ;Disable access
S U="^" K DIC,DIE,DR
Q:$D(^VA(200,"AFOF"))
S ^DD(200,32,9)="^"
S XU1="XUFI"
F S XU1=$O(^DIC(19,"B",XU1)) Q:XU1'["XUFI" F DA=0:0 S DA=$O(^DIC(19,"B",XU1,DA)) Q:DA'>0 S DR="2///ACCESS DISABLED",DIE="^DIC(19," D ^DIE
S XU1="XUFI" K DR
F S XU1=$O(^DIE("B",XU1)) Q:XU1'["XUFI" F DA=0:0 S DA=$O(^DIE("B",XU1,DA)) Q:DA'>0 I $P(^DIE(DA,0),U,4)=200 S DR=".01///*"_$P(^(0),U),DIE="^DIE(" D ^DIE
K DR,DIE
Q
;
ENABLE ;Enable access
S U="^",^DD(200,32,9)="#"
S XU1="XUFI" K DR
F S XU1=$O(^DIC(19,"B",XU1)) Q:XU1'["XUFI" F DA=0:0 S DA=$O(^DIC(19,"B",XU1,DA)) Q:DA'>0 S DR="2///@",DIE="^DIC(19," D ^DIE
S XU1="*XUFI" K DR
F S XU1=$O(^DIE("B",XU1)) Q:XU1'["*XUFI" F DA=0:0 S DA=$O(^DIE("B",XU1,DA)) Q:DA'>0 S DR=".01///"_$E($P(^DIE(DA,0),U),2,999),DIE="^DIE(" D ^DIE
K DR,DIE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUFILE3 943 printed Nov 22, 2024@17:19:39 Page 2
XUFILE3 ;SF-ISC/STAFF - FILE ACCESS CONTROL FOR KERNEL V8 ;07/26/94 16:24
+1 ;;8.0;KERNEL;;Jul 10, 1995
+2 QUIT
DISABLE ;Disable access
+1 SET U="^"
KILL DIC,DIE,DR
+2 if $DATA(^VA(200,"AFOF"))
QUIT
+3 SET ^DD(200,32,9)="^"
+4 SET XU1="XUFI"
+5 FOR
SET XU1=$ORDER(^DIC(19,"B",XU1))
if XU1'["XUFI"
QUIT
FOR DA=0:0
SET DA=$ORDER(^DIC(19,"B",XU1,DA))
if DA'>0
QUIT
SET DR="2///ACCESS DISABLED"
SET DIE="^DIC(19,"
DO ^DIE
+6 SET XU1="XUFI"
KILL DR
+7 FOR
SET XU1=$ORDER(^DIE("B",XU1))
if XU1'["XUFI"
QUIT
FOR DA=0:0
SET DA=$ORDER(^DIE("B",XU1,DA))
if DA'>0
QUIT
IF $PIECE(^DIE(DA,0),U,4)=200
SET DR=".01///*"_$PIECE(^(0),U)
SET DIE="^DIE("
DO ^DIE
+8 KILL DR,DIE
+9 QUIT
+10 ;
ENABLE ;Enable access
+1 SET U="^"
SET ^DD(200,32,9)="#"
+2 SET XU1="XUFI"
KILL DR
+3 FOR
SET XU1=$ORDER(^DIC(19,"B",XU1))
if XU1'["XUFI"
QUIT
FOR DA=0:0
SET DA=$ORDER(^DIC(19,"B",XU1,DA))
if DA'>0
QUIT
SET DR="2///@"
SET DIE="^DIC(19,"
DO ^DIE
+4 SET XU1="*XUFI"
KILL DR
+5 FOR
SET XU1=$ORDER(^DIE("B",XU1))
if XU1'["*XUFI"
QUIT
FOR DA=0:0
SET DA=$ORDER(^DIE("B",XU1,DA))
if DA'>0
QUIT
SET DR=".01///"_$EXTRACT($PIECE(^DIE(DA,0),U),2,999)
SET DIE="^DIE("
DO ^DIE
+6 KILL DR,DIE
+7 QUIT