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