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

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

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1DIU20 ;SFISC/GFT-SCREEN-EDIT FILE ;06:20 PM 2 Apr 2001
2 ;;22.0;VA FileMan;**8,82**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;from DIU0 -- DA=FILE NUMBER
6 N DR
7 S DDSFILE=1,DR="[DIEDIT]"
8 D ^DDS
9 Q
10 ;
11PRE ;
12 I DUZ(0)'="@" D
13 .F I=9.5,10,11,12 D UNED ;non-programmer cannot put in SCREEN, ACTION, LOOKUP, or CROSS-REF ROUTINE
14 .F I=2:1:7 D
15 ..S X=$G(^DIC(DA,0,$P("^DD^RD^WR^DEL^LAYGO^AUDIT",U,I)))
16 ..I X]"",$TR(X,DUZ(0))=X D UNED
17 D:'$D(DISYS) OS^DII I $G(^DD("OS",DISYS,18))="" F I=11,12 D UNED
18 Q
19 ;
20UNED D UNED^DDSUTL(I,"DIEDIT",1,1)
21 Q
22 ;
23ACCVAL(X) ;
24 I DUZ(0)'="@",$TR(X,DUZ(0))]"" S DDSERROR=1 D HLP^DDSUTL("MUST MATCH YOUR OWN ACCESS CODE") Q
25 I (X["?") S DDSERROR=1 D HLP^DDSUTL("CANNOT CONTAIN '?'") Q
26 Q
27 ;
28POST ;
29 N I,NAMENOW,ROOT,SP
30MAYBGONE Q:'$G(DA)
31 S NAMENOW=$P(^DIC(DA,0),U) ;has FILE NAME changed?
32 S X=$$G(.2) I X="" G KILLFILE
33 S ROOT=^DIC(DA,0,"GL")_"0)",SP=$P(@ROOT,U,2)
34 I X'=NAMENOW K I D PUT^DDSVAL(1,DA,.01,X,.I) Q:$D(I)>1 D
35 .S $P(@ROOT,U)=X
36 .K ^DD(DA,0,"NM") S ^("NM",X)=""
37 F I=2:1:7 D ;handle the 6 ACCESS CODEs
38 .S X=$$G(I)
39 .S ^DIC(DA,0,$P("^DD^RD^WR^DEL^LAYGO^AUDIT",U,I))=X
40 S X=$$G(8) S ^DD(D0,0,"DDA")=$E("NY",X+1)
41 S X=$$G(9) S I=$G(^DIC(DA,0,"GL")) I I["(",$D(@(I_"0)")) S I=$P(^(0),U,2),I=$TR(I,"O"),$P(^(0),U,2)=I_$E("O",X)
42 S X=$$G(9.5),^DD(DA,0,"SCR")=X,SP=$TR(SP,"s") I X="" K ^("SCR")
43 E S SP=SP_"s"
44 S $P(@ROOT,U,2)=SP
45ACTION S X=$$G(10),^DD(DA,0,"ACT")=X I X="" K ^("ACT")
46 S X=$$G(11),^DD(DA,0,"DIC")=X I X="" K ^("DIC")
47 D:$G(^DD(DA,0,"DIK"))]"" QA^DIU21
48 S X=$$G(12) I X]"" D
49 .N DMAX,DIR,DICMP,DIKPGM,Y
50 .S Y=DA,DMAX=^DD("ROU") D EN^DIKZ
51 Q
52 ;
53G(I) Q $$GET^DDSVALF(I,"DIEDIT",1)
54 ;
55DIU S DIU=^DIC(DA,0,"GL"),DIU(0)="EDT" Q
56 ;
57KILLFILE ;
58 N DIK,DIC,DQ,DIER,A,DIU
59 S DIC="^DIC("
60 D DIU F DIK=0:0 S DIK=$O(^DD(1,.01,"DEL",DIK)) Q:'DIK I $D(^(DIK,0)) X ^(0) I S DDSERROR=1,DDSBR=.2 D PUT^DDSVALF(.2,"DIEDIT",1,NAMENOW) H 3 G Q ;DELETE logic
61 S A=DA,DIK="^DIC(" D
62 .N A,DIU D ^DIK ;kill off the File 1 entry
63 D 61^DIU0
64Q Q
65 ;
66TEST ;
67 S DIC=1,DIC(0)="AEQM" D ^DIC Q:Y<0 S DA=+Y G DIU20
Note: See TracBrowser for help on using the repository browser.