XUFILE3.m

XUFILE3 ;SF-ISC/STAFF - FILE ACCESS CONTROL FOR KERNEL V8 ;07/26/94  16:24 [ 04/02/2003   8:29 AM ]

 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003

 ;;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

XUFILE3   ;SF-ISC/STAFF - FILE ACCESS CONTROL FOR KERNEL V8 ;07/26/94  16:24 [ 04/02/2003   8:29 AM ]

 +1       ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003

 +2       ;;8.0;KERNEL;;Jul 10, 1995

 +3        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