Return to DIU21.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIU21.m, revision 1.1

1.1     ! snw         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'