Return to DIU0.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DIU0	;SFISC/XAK-EDIT/DELETE A FILE ;7/2/93  4:08 PM
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: DIPZ	;
    5: 	D PZ,DIEZ Q
    6: PZ	;
    7: 	S DIU2=$S($D(J(0))#2:J(0),1:"") N DIC,C,F,I,J,M,O,Q,S,T,V,W,Y
    8: 	F DIU0=0:0 S DIU0=$O(^DIPT("AF",DI,DA,DIU0)) Q:DIU0'>0  K ^(DIU0),^DIPT(DIU0,"ROU") S DMAX=^DD("ROU"),X=^DIPT(DIU0,"ROUOLD"),Y=DIU0,DIU1=DI D EN^DIPZ S DI=DIU1
    9: 	S J(0)=DIU2 D DT Q
   10: 	;
   11: DIEZ	N DL,DH,DQ,DIE,DIC,DNM,DR,M,T,F,Q,Y F DIU0=0:0 S DIU0=$O(^DIE("AF",DI,DA,DIU0)) Q:DIU0'>0  K ^(DIU0),^DIE(DIU0,"ROU") S DMAX=^DD("ROU"),X=^DIE(DIU0,"ROUOLD"),Y=DIU0,DIU1=DI D EN^DIEZ S DI=DIU1
   12: DT	I $D(^DD(DI,DA)) S:$S($D(^DIC(J(0),"%A")):$P(^("%A"),U,2),1:0)-DT ^DD(DI,DA,"DT")=DT
   13: 	K DIU0,DIU1,DIU2 W ! Q
   14: 	;
   15: EN	;
   16: 	I DIU,DIU(0)["S" G SUB
   17: 	I DIU,$D(^DIC(DIU,0,"GL")) S DIU=^("GL")
   18: 	G Q:DIU S DIK="^DIC(",DG=$S($D(@(DIU_"0)")):^(0),1:""),(A,DA)=+$P(DG,U,2)
   19: 	G Q:'A D ^DIK G 61
   20: 6	S DR=".01:10;"_$P(20,U,$S($D(^DIC(200,0)):^(0)["NEW PERSON",$D(^DIC(3,0)):^(0)["USER"!(^(0)["EMPLOY"),1:0))
   21: 	S DIE=1,(A,DA)=DI,DIER=1 D ^DIE K DIER G N^DIU2:$D(DA)
   22: 61	S DQ(A)=0 G:DIU(0)'["D" 63
   23: 	S Y=$L(DIU),Y=$E(DIU,1,Y-1)_$E(")",$E(DIU,Y)=","),%=0
   24: 	I DIU(0)["E" W !?3,"OK TO DELETE THE '"_Y_"' GLOBAL" D YN^DICN K:%=1 @Y G 63
   25: 	K @Y
   26: 63	W:DIU(0)["E" !?3,"Deleting the DATA DICTIONARY..." D KDD^DICATT4
   27: 	Q:DIU(0)["S"  G Q:DIU(0)'["T"
   28: 	F DIK="^DIE(","^DIPT(","^DIBT(" K @(DIK_"""F""_A)") W:DIU(0)["E" !?3,"Deleting the "_$P(^(0),U)_"S..." S DA=.9 F  S DA=$O(@(DIK_"DA)")) Q:DA'>0  I $D(^(DA,0)) S %=$P(^(0),U,4) I %=""!'$D(^DD(+%)) W:DIU(0)["E" "." D ^DIK
   29: 	D FORM^DDSDEL(A,DIU(0)["E")
   30: Q	K A,DA,DG,DIK,DQ Q
   31: 	;
   32: SUB	G Q:'$D(^DD(DIU,0,"UP")) S DA(1)=^("UP"),DQ(DIU)=0
   33: 	I DIU(0)'["D" S A=DA(1) D 63 S A=DIU G SE
   34: 	S D0=DIU,S=";",Q=""""
   35: 	F I=1:1 Q:'$D(^DD(DIU,0,"UP"))  S A=^("UP"),%=$O(^DD(A,"SB",DIU,0)) Q:%=""  Q:'$D(^DD(A,%,0))#2  S %(I)=$P($P(^(0),U,4),S),DIU=A S:+%(I)'=%(I) %(I)=Q_%(I)_Q I I=1 S (O,M)=^(0)
   36: 	S DICL=I-2 F I=1:1:DICL S I(I)=%(DICL-I+1)
   37: 	S I(0)=^DIC(DIU,0,"GL") K % D 63 S A=D0 D EN^DICATT4
   38: SE	S DIK="^DD("_DA(1)_",",DA=$O(^DD(DA(1),"SB",A,0)) D ^DIK:DA
   39: 	K D0,DICL,E,I,M,O,Q,S,T,X,Y G Q