| [613] | 1 | DIU20 ;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 | ;
|
|---|
| 11 | PRE ;
|
|---|
| 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 | ;
|
|---|
| 20 | UNED D UNED^DDSUTL(I,"DIEDIT",1,1)
|
|---|
| 21 | Q
|
|---|
| 22 | ;
|
|---|
| 23 | ACCVAL(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 | ;
|
|---|
| 28 | POST ;
|
|---|
| 29 | N I,NAMENOW,ROOT,SP
|
|---|
| 30 | MAYBGONE 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
|
|---|
| 45 | ACTION 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 | ;
|
|---|
| 53 | G(I) Q $$GET^DDSVALF(I,"DIEDIT",1)
|
|---|
| 54 | ;
|
|---|
| 55 | DIU S DIU=^DIC(DA,0,"GL"),DIU(0)="EDT" Q
|
|---|
| 56 | ;
|
|---|
| 57 | KILLFILE ;
|
|---|
| 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
|
|---|
| 64 | Q Q
|
|---|
| 65 | ;
|
|---|
| 66 | TEST ;
|
|---|
| 67 | S DIC=1,DIC(0)="AEQM" D ^DIC Q:Y<0 S DA=+Y G DIU20
|
|---|
