freem_fileman/USER/DIU21.m - view

File: [Coherent Logic Development] / freem_fileman / USER / DIU21.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:21 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD

Restructure repository

1: DIU21 ;SFISC/XAK-EDIT FILE (PGMR PART) ;12/20/93 10:28 2: ;;21.0;VA FileMan;;Dec 28, 1994 3: ;Per VHA Directive 10-93-142, this routine should not be modified. 4: D:'$D(DISYS) OS^DII Q:$G(^DD("OS",DISYS,18))="" 5: ACT K DIR S DIR(0)="FOU^3:250",DIR("A")=$$EZBLD^DIALOG(8013) S:$D(^DD(DA,0,"ACT")) DIR("B")=^("ACT") 6: S DIR("?",1)=$$EZBLD^DIALOG(9025),DIR("?")=$$EZBLD^DIALOG(9024) 7: D ^DIR G:$D(DTOUT)!($D(DUOUT)) Q K DIRUT,DIROUT G:X="" DIC 8: I "@"'[X D ^DIM I $D(X) S ^DD(DA,0,"ACT")=X G DIC 9: I $G(X)="@" K ^DD(DA,0,"ACT") W " "_$$EZBLD^DIALOG(8015) G DIC 10: W $C(7)," ",$$EZBLD^DIALOG(9025) G ACT 11: DIC K DIR N Y,DIPARAM S DIR(0)="FO^3:8^K:X?1""DI"".E X",DIR("A")=$$EZBLD^DIALOG(8014) S:$G(^DD(DA,0,"DIC"))]"" DIR("B")=^("DIC") 12: S DIPARAM=9026,DIPARAM(1)=8 D H,H1 13: D ^DIR K DIRUT,DIROUT 14: G:$D(DTOUT)!($D(DUOUT)) Q G:X="" DIK 15: I X="@" K ^DD(DA,0,"DIC") W " "_$$EZBLD^DIALOG(8015) G DIK 16: I '$$ROUEXIST^DILIBF(X) W $C(7)," ",$$EZBLD^DIALOG(8017) G DIC 17: S ^DD(DA,0,"DIC")=X 18: DIK S X=$G(^DD(DA,0,"DIKOLD")),Y=$G(^("DIK")) I X]"",X'=Y W !," " D BLD^DIALOG(8018,X,"","DIR") W DIR 19: K DIR S DIR(0)="FO^3:6^K:X?1""DI"".E X",DIR("A")=$$EZBLD^DIALOG(8019) S:Y]"" DIR("B")=Y 20: S DIPARAM=9027,DIPARAM(1)=6 D H,H1 21: D ^DIR I X="@" G QA 22: G:$D(DIRUT)!(X="") Q 23: I $$ROUEXIST^DILIBF(X) W $C(7),! S DIPARAM(1)=X D BLD^DIALOG(8016,.DIPARAM,"","DIR") W DIR 24: K DIR N DICMP S DICMP=0 I $G(^DD(DA,0,"DIK"))=""!($G(^("DIK"))'=X) S DICMP=1 25: N DIKPGM S DIKPGM=X 26: S DIR(0)="YO",DIR("A")=$$EZBLD^DIALOG(8020) 27: I 'DICMP S DIR("B")="NO" D BLD^DIALOG(9028,"","","DIR(""?"")") 28: I DICMP S DIR("B")="YES" D BLD^DIALOG(9029,"","","DIR(""?"")") 29: D ^DIR G Q:$D(DIRUT) 30: I 'Y G:'DICMP Q W $C(7) G QA 31: S X=DIKPGM,Y=DA,DMAX=^DD("ROU") K DIR,DICMP,DIKPGM G EN^DIKZ 32: ; 33: A N DA S DA=+X N X K ^DD(DA,0,"DIK") 34: F X=0:0 S X=$O(^DD(DA,"SB",X)) Q:X'>0 D A 35: Q 36: QA S X=DA D A W " "_$$EZBLD^DIALOG(8015),!," ",$$EZBLD^DIALOG(8021) 37: Q Q 38: H ; Build help for entering routine name. 39: D BLD^DIALOG(9006,.DIPARAM,"","DIR(""?"")") Q 40: H1 N I S I=$O(DIR("?",":"),-1) I I S DIR("?",I+1)=DIR("?") 41: I DIPARAM=9027 S DIR("?",I+2)=$$EZBLD^DIALOG(9030) 42: D BLD^DIALOG(DIPARAM,"","","DIR(""?"")") Q 43: ; 44: DIE ;not in 20 45: I $P($G(^DD(DA,0,"DI")),U)["Y" W !,$C(7),"RESTRICT EDITING OF FILE? YES// (UNEDITABLE) THIS IS AN ARCHIVE FILE." Q 46: N DIR,DIEYN S DIR(0)="YO",DIR("A")="RESTRICT EDITING OF FILE",DIR("B")=$S($P($G(^DD(DA,0,"DI")),U,2)["Y":"YES",1:"NO") 47: S DIR("?",1)="YES will not allow editing or deleting existing file entries or adding new file entries",DIR("?")="NO will place no restrictions on the file" 48: D ^DIR Q:$D(DTOUT)!$D(DUOUT) 49: S DIEYN=$S(Y:"Y",1:"N") 50: D DIE1 Q:$D(DTOUT)!($D(DUOUT)) G:'$D(DIEYN) DIE 51: S $P(^DD(DA,0,"DI"),U,2)=DIEYN 52: Q 53: DIE1 Q:Y&($E(DIR("B"))="Y") Q:'Y&($E(DIR("B"))="N") 54: I Y W !,$C(7),"WARNING- DATA IN THIS FILE IS NOW UNEDITABLE" 55: I 'Y W !,$C(7),"WARNING- DATA IN THIS FILE IS NOW EDITABLE" 56: K DIR S DIR(0)="Y",DIR("A")="ARE YOU SURE" 57: D ^DIR Q:$D(DTOUT)!$D(DUOUT) K:'Y DIEYN 58: Q 59: ; 60: ;DIALOG #8013 'POST-SELECTION ACTION' 61: ; #8014 'LOOK-UP PROGRAM' 62: ; #8015 'Deleted.' 63: ; #8016 'Note that...is already in the routine directory.' 64: ; #8017 'This routine does not exist in the routine directory.' 65: ; #8018 'Previously compiled under routine name...' 66: ; #8019 'CROSS-REFERENCE ROUTINE' 67: ; #8020 'Should the compilation run now' 68: ; #8021 'The compiled routines will no longer be used...' 69: ; #9006 'Enter a valid MUMPS routine name of from 3 to...' 70: ; #9024 'This code will be executed whenever an entry is...' 71: ; #9025 'Enter a line of standard MUMPS code' 72: ; #9026 'This special lookup routine will be executed...' 73: ; #9027 'if a NEW routine name is entered, but the cross-ref...' 74: ; #9028 'It is not necessary to recompile the cross-ref...' 75: ; #9029 'If the cross-references are not recompiled...' 76: ; #9030 'This will become the namespace of the compiled routine'