source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIU0.m@ 1801

Last change on this file since 1801 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.5 KB
RevLine 
[613]1DIU0 ;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.
4DIPZ ;
5 D PZ,DIEZ Q
6PZ ;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 ;
11IN(DI,DA) ;Recompile INput Templates containing Field DA, File DI
12 N J,I D IJ^DIUTL(DI)
13DIEZ 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
21DT 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 ;
24EN ;
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
306 ;
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 ;
35SCROLL 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
3861 ; delete a FILE!
39 S DQ(A)=0 K ^DIA(A) I $G(DIKLGLBL)]"" K @DIKLGLBL
4063 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")
44Q K A,DA,DG,DIK,DQ Q
45 ;
46SUB 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
57SE 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
Note: See TracBrowser for help on using the repository browser.