Return to DIU21.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIU21.m, revision 1.1.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'