- XUINCON ;SF/XAK - BUILDS ACCESSIBLE FILE MULTIPLE ;2/9/95 09:44 [ 04/02/2003 8:29 AM ]
- ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
- ;;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
- XUINCON ;SF/XAK - BUILDS ACCESSIBLE FILE MULTIPLE ;2/9/95 09:44 [ 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 IF '$DATA(^VA(200,"AFOF"))
- GOTO A
- WRITE !,"You currently have the 'AFOF' X-ref that shows you are",!,"using the accessible file."
- +4 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
