Annotation of freem_fileman/DIU.m, revision 1.1

1.1     ! snw         1: DIU    ;SFISC/GFT-UTILITY FUNCTIONS ;10/11/94  16:01
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        K DIU
        !             5: 0      S DIC="^DOPT(""DIU"","
        !             6:        G OPT:$D(^DOPT("DIU",10)) S ^(0)="UTILITY OPTION^1.01" K ^("B")
        !             7:        F X=1:1:10 S ^DOPT("DIU",X,0)=$P($T(@X),";;",2)
        !             8:        S DIK=DIC D IXALL^DIK S ^DOPT("DICR",0)="TYPE OF INDEXING^1.01"
        !             9:        F X=1:1:7 S ^DOPT("DICR",X,0)=$P("REGULAR^KWIC^MNEMONIC^MUMPS^SOUNDEX^TRIGGER^BULLETIN",U,X)
        !            10:        S DIK="^DOPT(""DICR""," D IXALL^DIK G 0
        !            11: OPT    ;
        !            12:        S DIC(0)="AEQIZ" S:DUZ(0)'="@" DIC("S")="I Y-5"
        !            13:        D ^DIC G Q:Y<0 S DI=Y D EN G 0
        !            14:        ;
        !            15: EN     ;
        !            16:        D D^DICRW G Q:Y<0 I '$D(DIC) D DIE^DIB G Q:'$D(DG) S DIC=DG
        !            17:        S DIU=DIC,DIU(0)="EDT" K DICS
        !            18:        K DIC,I,J S Y=DI,N=0,DI=+$P($G(@(DIU_"0)")),U,2),J(0)=DI,I(0)=DIU
        !            19:        I 'DI W $C(7),!,"Missing or incomplete global node "_DIU_"0)",! G Q
        !            20:        K DDA I $D(^DD(DI,0,"DDA")),^("DDA")["Y" S DDA=""
        !            21:        D @+Y W !!
        !            22: Q      K %,DIUF,DG,DGG,DIC,DIU,DJJ,DIK,DI,DA,I,J,X,Y,DICD,DICDF,DDA,DIFLD,DTOUT,DUOUT Q
        !            23:        ;
        !            24: 1      ;;VERIFY FIELDS
        !            25:        G ^DIV
        !            26:        ;
        !            27: 2      ;;CROSS-REFERENCE A FIELD
        !            28:        S X="CW" D DI Q:Y<.002  G ^DICD
        !            29:        ;
        !            30: 3      ;;IDENTIFIER
        !            31:        S X="CW.01" D DIAX Q:'$T  D DI Q:Y<0  G 3^DIU3
        !            32:        ;
        !            33: 4      ;;RE-INDEX FILE
        !            34:        G 4^DIU1
        !            35:        ;
        !            36: 5      ;;INPUT TRANSFORM (SYNTAX)
        !            37:        S X="W" D DIAX Q:'$T  D DI Q:Y<0  G 5^DIU31
        !            38:        ;
        !            39: 6      ;;EDIT FILE
        !            40:        G 6^DIU0
        !            41:        ;
        !            42: 7      ;;OUTPUT TRANSFORM
        !            43:        S X="CW" D DI Q:Y<0  G O^DIU31
        !            44:        ;
        !            45: 8      ;;TEMPLATE EDIT
        !            46:        G 0^DIBT
        !            47:        ;
        !            48: 9      ;;UNEDITABLE DATA
        !            49:        S X="WC" D DIAX Q:'$T  D DI Q:Y<0  G 9^DIU31
        !            50:        ;
        !            51: 10     ;;MANDATORY/REQUIRED FIELD CHECK
        !            52:        G ^DIVRE
        !            53:        ;
        !            54: 11     ;;SPECIFIER
        !            55:        S X="CW",N=0 D DI Q:Y<0  G ^DIU4
        !            56: DI     ;
        !            57:        S DIC(0)="ZQEAI"
        !            58: D      ;
        !            59:        S DIC="^DD("_DI_",",DIC("W")="S %=$P(^(0),U,2) I % W $S($P(^DD(+%,.01,0),U,2)[""W"":""  (word-processing)"",1:""  (multiple)"")"
        !            60:        S DIC("S")="S %=$P(^(0),U,2) I 1"_$P(",%'[""C""",U,X["C")_$P(",$P(^DD(+%,.01,0),U,2)'[""W""",9,X["W")_$P(",Y-.01",U,X[.01),DA=X
        !            61:        D ^DIC K DIC("S") I Y>0,$P(Y(0),U,2) S N=N+1,X=$P($P(Y(0),U,4),";",1),DI=$E("""",+X'=X),I(N)=DI_X_DI,(DI,J(N))=+$P(Y(0),U,2),X=DA G DI
        !            62:        Q
        !            63: DIAX   I '$D(^DD(DI,0,"DI"))!($P($G(^("DI")),U)'["Y")!($P($G(^("DI")),U)["Y"&'$P(@(^DIC(DI,0,"GL")_"0)"),U,4))
        !            64:        W:'$T !!,$C(7),"THIS DATA DICTIONARY CHANGE IS NOT ALLOWED ON AN ARCHIVE FILE!"
        !            65:        Q

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>