1 | DIU0 ;SFISC/XAK-EDIT/DELETE A FILE ;1:41 PM 12 Nov 2002
|
---|
2 | ;;22.0;VA FileMan;**82,116,76**;Mar 30, 1999
|
---|
3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | DIPZ ;
|
---|
5 | D PZ,DIEZ Q
|
---|
6 | PZ ;Recompile PRINT Template routines
|
---|
7 | S DIU2=$G(J(0)) 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 | IN(DI,DA) ;Recompile INput Templates containing Field DA, File DI
|
---|
12 | N J,I D IJ^DIUTL(DI)
|
---|
13 | DIEZ N DL,DH,DQ,DIE,DIC,DNM,DR,M,T,F,Q,Y
|
---|
14 | F DIU0=0:0 S DIU0=$O(^DIE("AF",DI,DA,DIU0)) Q:DIU0'>0 D
|
---|
15 | . S X=$G(^DIE(DIU0,"ROUOLD"))
|
---|
16 | . I X'?1(1A,1"%").7AN D I X'?1(1A,1"%").7AN D UNC^DIEZ(DIU0) Q
|
---|
17 | .. S X=$P($G(^DIE(DIU0,"ROU")),U,2)
|
---|
18 | . K ^DIE("AF",DI,DA,DIU0),^DIE(DIU0,"ROU")
|
---|
19 | . S DMAX=^DD("ROU"),Y=DIU0,DIU1=DI
|
---|
20 | . D EN^DIEZ S DI=DIU1
|
---|
21 | DT I $D(^DD(DI,DA)) S:$P($G(^DIC(J(0),"%A")),U,2)-DT ^DD(DI,DA,"DT")=DT
|
---|
22 | K DIU0,DIU1,DIU2 W ! Q
|
---|
23 | ;
|
---|
24 | EN ;
|
---|
25 | I DIU,DIU(0)["S" G SUB
|
---|
26 | I DIU,$D(^DIC(DIU,0,"GL")) S DIU=^("GL")
|
---|
27 | G Q:"(,"'[$E($RE(DIU))!DIU S DIK="^DIC(",DG=$G(@(DIU_"0)")),(A,DA)=+$P(DG,U,2) G Q:'A
|
---|
28 | N DIKLGLBL I DIU(0)["D" S DIKLGLBL=$$CREF^DILF(DIU)
|
---|
29 | D ^DIK G 61
|
---|
30 | 6 ;
|
---|
31 | N DIKLGLBL
|
---|
32 | S DA=DI I $S($T(SCREEN^DIBT)["HELP":'$$SCREEN^DIBT("^D SCREENQ^DICATT"),1:1) G SCROLL
|
---|
33 | G ^DIU20
|
---|
34 | ;
|
---|
35 | SCROLL 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))
|
---|
36 | S DIE=1,(A,DA)=DI,DIER=1 D K DIER G N^DIU2:$D(DA)
|
---|
37 | .N A D ^DIE
|
---|
38 | 61 ; delete a FILE!
|
---|
39 | S DQ(A)=0 K ^DIA(A) I $G(DIKLGLBL)]"" K @DIKLGLBL
|
---|
40 | 63 W:DIU(0)["E" !?3,"Deleting the DATA DICTIONARY..." D KDD^DICATT4
|
---|
41 | Q:DIU(0)["S" G Q:DIU(0)'["T"
|
---|
42 | 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
|
---|
43 | D FORM^DDSDEL(A,DIU(0)["E")
|
---|
44 | Q K A,DA,DG,DIK,DQ Q
|
---|
45 | ;
|
---|
46 | SUB G Q:'$D(^DD(DIU,0,"UP")) S DA(1)=^("UP"),DQ(DIU)=0
|
---|
47 | I DIU(0)'["D" S A=DA(1) D 63 S A=DIU G SE
|
---|
48 | S D0=DIU,S=";",Q=""""
|
---|
49 | 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)
|
---|
50 | S DICL=I-2 F I=1:1:DICL+1 S I(I)=%(DICL-I+2)
|
---|
51 | S I(0)=^DIC(DIU,0,"GL") K %
|
---|
52 | D
|
---|
53 | . N DIU0TOP,DIU0SFIL S DIU0TOP=A,DIU0SFIL=D0
|
---|
54 | . N A,DA,D0,DICL,DIU,DQ,I,O,M,S,Q
|
---|
55 | . D INDEX^DIKC(DIU0TOP,"","","","KiRW"_DIU0SFIL)
|
---|
56 | D 63 S A=D0 D EN^DICATT4
|
---|
57 | SE S DIK="^DD("_DA(1)_",",DA=$O(^DD(DA(1),"SB",A,0)) D ^DIK:DA
|
---|
58 | K D0,DICL,E,I,M,O,Q,S,T,X,Y G Q
|
---|