XUINCON ;SF/XAK - BUILDS ACCESSIBLE FILE MULTIPLE ;2/9/95 09:44
;;8.0;KERNEL;;Jul 10, 1995
G A:'$D(^VA(200,"AFOF")) W !,"You currently have the 'AFOF' X-ref that shows you are",!,"using the accessible file."
W !,"If you need to re-run the conversion please kill the '^VA(200,""AFOF"")' X-ref first." Q
A W !!,"Version 7 of the Kernel defined a new multiple-valued field"
W !,"in the New Person File called Accessible File. This conversion"
W !,"will store file access in this multiple in the following manner:"
W !!,"Those Users who have a FileMan Access Code (DUZ(0)) which"
W !,"is not null, i.e., contains some character string,"
W !,"will have their access string matched to the protection"
W !,"currently on your files. For each match between the file"
W !,"and the user, the file will be listed in the user's"
W !,"Accessible File multiple as will the type of access"
W !,"(dictionary, delete, laygo, read, write, audit)."
W !!,"NOTE: Files with no protection will NOT be assigned to any user.",!
AGN S %=2,U="^" W !!,"Would you like to run the conversion now " D YN^DICN
G GO:%=1 I %=2!(%<0) W !!,"To run this conversion, D ^XUINCON." G KIL
W !!,"If you are uncertain about your current file protection, it would"
W !,"be wiser to examine them before running this."
W !,"If you are not on the CPU which holds the user file, it would"
W !,"be better to run this conversion on that CPU."
W !,"If you are short for time, it would be wiser to run this later."
G AGN
GO W !,$H,!,"Build table." I '$D(DT) S DT=$$HTFM^XLFDT($H)\1
K ^TMP($J) S X="DD^DEL^LAYGO^RD^WR^$$$" K XU
F I=1.99:0 S I=$O(^DIC(I)) Q:I'>0 F J=1:1:6 I $D(^DIC(I,0,$P(X,U,J))),"@"'[^($P(X,U,J)) S %=^($P(X,U,J)) F K=1:1:$L(%) S ^TMP($J,$E(%,K),I,J+1)=""
W !,"Convert Users."
F I=0:0 S I=$O(^VA(200,I)) Q:I'>0 S X=$G(^(I,0)),%=$P(X,U,11) I $S(%:%'<DT,1:1),$P(X,U,3)]"",$P(X,U,4)]"" S %=$P(X,U,4) D CHECK:%'="@"
D DISV,XREF W !,"Done",$H
KIL K ^TMP($J),I,J,K Q
;
CHECK ;
F J=1:1:$L(%) F K=0:0 S K=$O(^TMP($J,$E(%,J),K)) Q:K'>0 F L=0:0 S L=$O(^TMP($J,$E(%,J),K,L)) Q:L'>0 S $P(^VA(200,I,"FOF",K,0),U,L)=1,$P(^(0),U)=K
Q
DISV ;
W !,"Give access from DISV file."
F I=.5:0 S I=$O(^DISV(I)) Q:+I'=I I $D(^VA(200,I,0)),'$P(^(0),U,11),$P(^(0),U,3)]"",$P(^(0),U,4)'="@" S X="" D D1
Q
D1 ;
F J=0:0 S X=$O(^DISV(I,X)) Q:X="" I $E(X)=U,"(,"[$E(X,$L(X)),$L(X,",")<3,X'?1"^DD".E,X'="^DIC(",X'?1"^DOPT".E,$D(@(X_"0)")) S J=+$P(^(0),U,2) I J'<2,'$D(^VA(200,I,"FOF",J,0)) S ^(0)=J_"^^^^1^"_0 ;(J'=3)
Q
XREF W !,"X-ref."
F I=0:0 S I=$O(^VA(200,I)) Q:I'>0 S K=0,%=0 D
. F J=0:0 S J=$O(^VA(200,I,"FOF",J)) Q:J'>0 S %=J,K=K+1,^VA(200,I,"FOF","B",J,J)="",^VA(200,"AFOF",J,I,J)=""
. S ^VA(200,I,"FOF",0)="^200.032PA^"_%_U_K
. Q
Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUINCON 2774 printed Apr 09, 2024@21:13:29 Page 2
XUINCON ;SF/XAK - BUILDS ACCESSIBLE FILE MULTIPLE ;2/9/95 09:44
+1 ;;8.0;KERNEL;;Jul 10, 1995
+2 if '$DATA(^VA(200,"AFOF"))
GOTO A
WRITE !,"You currently have the 'AFOF' X-ref that shows you are",!,"using the accessible file."
+3 WRITE !,"If you need to re-run the conversion please kill the '^VA(200,""AFOF"")' X-ref first."
QUIT
A WRITE !!,"Version 7 of the Kernel defined a new multiple-valued field"
+1 WRITE !,"in the New Person File called Accessible File. This conversion"
+2 WRITE !,"will store file access in this multiple in the following manner:"
+3 WRITE !!,"Those Users who have a FileMan Access Code (DUZ(0)) which"
+4 WRITE !,"is not null, i.e., contains some character string,"
+5 WRITE !,"will have their access string matched to the protection"
+6 WRITE !,"currently on your files. For each match between the file"
+7 WRITE !,"and the user, the file will be listed in the user's"
+8 WRITE !,"Accessible File multiple as will the type of access"
+9 WRITE !,"(dictionary, delete, laygo, read, write, audit)."
+10 WRITE !!,"NOTE: Files with no protection will NOT be assigned to any user.",!
AGN SET %=2
SET U="^"
WRITE !!,"Would you like to run the conversion now "
DO YN^DICN
+1 if %=1
GOTO GO
IF %=2!(%<0)
WRITE !!,"To run this conversion, D ^XUINCON."
GOTO KIL
+2 WRITE !!,"If you are uncertain about your current file protection, it would"
+3 WRITE !,"be wiser to examine them before running this."
+4 WRITE !,"If you are not on the CPU which holds the user file, it would"
+5 WRITE !,"be better to run this conversion on that CPU."
+6 WRITE !,"If you are short for time, it would be wiser to run this later."
+7 GOTO AGN
GO WRITE !,$HOROLOG,!,"Build table."
IF '$DATA(DT)
SET DT=$$HTFM^XLFDT($HOROLOG)\1
+1 KILL ^TMP($JOB)
SET X="DD^DEL^LAYGO^RD^WR^$$$"
KILL XU
+2 FOR I=1.99:0
SET I=$ORDER(^DIC(I))
if I'>0
QUIT
FOR J=1:1:6
IF $DATA(^DIC(I,0,$PIECE(X,U,J)))
IF "@"'[^($PIECE(X,U,J))
SET %=^($PIECE(X,U,J))
FOR K=1:1:$LENGTH(%)
SET ^TMP($JOB,$EXTRACT(%,K),I,J+1)=""
+3 WRITE !,"Convert Users."
+4 FOR I=0:0
SET I=$ORDER(^VA(200,I))
if I'>0
QUIT
SET X=$GET(^(I,0))
SET %=$PIECE(X,U,11)
IF $SELECT(%:%'<DT,1:1)
IF $PIECE(X,U,3)]""
IF $PIECE(X,U,4)]""
SET %=$PIECE(X,U,4)
if %'="@"
DO CHECK
+5 DO DISV
DO XREF
WRITE !,"Done",$HOROLOG
KIL KILL ^TMP($JOB),I,J,K
QUIT
+1 ;
CHECK ;
+1 FOR J=1:1:$LENGTH(%)
FOR K=0:0
SET K=$ORDER(^TMP($JOB,$EXTRACT(%,J),K))
if K'>0
QUIT
FOR L=0:0
SET L=$ORDER(^TMP($JOB,$EXTRACT(%,J),K,L))
if L'>0
QUIT
SET $PIECE(^VA(200,I,"FOF",K,0),U,L)=1
SET $PIECE(^(0),U)=K
+2 QUIT
DISV ;
+1 WRITE !,"Give access from DISV file."
+2 FOR I=.5:0
SET I=$ORDER(^DISV(I))
if +I'=I
QUIT
IF $DATA(^VA(200,I,0))
IF '$PIECE(^(0),U,11)
IF $PIECE(^(0),U,3)]""
IF $PIECE(^(0),U,4)'="@"
SET X=""
DO D1
+3 QUIT
D1 ;
+1 ;(J'=3)
FOR J=0:0
SET X=$ORDER(^DISV(I,X))
if X=""
QUIT
IF $EXTRACT(X)=U
IF "(,"[$EXTRACT(X,$LENGTH(X))
IF $LENGTH(X,",")<3
IF X'?1"^DD".E
IF X'="^DIC("
IF X'?1"^DOPT".E
IF $DATA(@(X_"0)"))
SET J=+$PIECE(^(0),U,2)
IF J'<2
IF '$DATA(^VA(200,I,"FOF",J,0))
SET ^(0)=J_"^^^^1^"_0
+2 QUIT
XREF WRITE !,"X-ref."
+1 FOR I=0:0
SET I=$ORDER(^VA(200,I))
if I'>0
QUIT
SET K=0
SET %=0
Begin DoDot:1
+2 FOR J=0:0
SET J=$ORDER(^VA(200,I,"FOF",J))
if J'>0
QUIT
SET %=J
SET K=K+1
SET ^VA(200,I,"FOF","B",J,J)=""
SET ^VA(200,"AFOF",J,I,J)=""
+3 SET ^VA(200,I,"FOF",0)="^200.032PA^"_%_U_K
+4 QUIT
End DoDot:1
+5 QUIT
+6 QUIT
