- 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 Feb 18, 2025@23:35:57 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
