Return to DIDX.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIDX.m, revision 1.1

1.1     ! snw         1: DIDX   ;SFISC/XAK-BRIEF DD ;11/3/93  15:29
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        S D1=D0,DINM=1,DDRG=1,DDL1=14,DDL2=32 G B
        !             5:        ;
        !             6: L      S DJ(Z)=0
        !             7: A      I DIDX D  G:D1>0 A:^DD(F(Z),"B",DJ(Z),D1)
        !             8:        . S DJ(Z)=$O(^DD(F(Z),"B",DJ(Z))) S:DJ(Z)="" D1="" Q:DJ(Z)=""  S D1=$O(^(DJ(Z),0))
        !             9:        . Q
        !            10:        E  S (D1,DJ(Z))=$O(^DD(F(Z),DJ(Z)))
        !            11:        I D1'>0 W ! S Z=Z-1 Q
        !            12: B      I $D(DIGR),D1-.01!'DID X DIGR E  G END
        !            13:        S N=^DD(F(Z),D1,0) D HD:$Y+9>IOSL Q:M=U  W !!?Z+Z-2,$P(N,U,1),?30,S,F(Z),",",D1,S,S
        !            14:        S X=$P(N,U,2) I X W ?M,$J(+X,8) I $D(^DD(+X,.01,0)),$P(^(0),U,2)["W" W "  WORD-PROCESSING" S X=""
        !            15:        W ?M,S,S F W="BOOLEAN","COMPUTED","FREE TEXT","SET","DATE","NUMBER","POINTER","VARIABLE POINTER","K" I X[$E(W) S:W="K" W="MUMPS" D W1 I X["V" D VP0
        !            16:        G T:X'["P"!X S Y=$P(N,U,3) I Y]"",@("$D(^"_Y_"0))") S W="TO "_$P(^(0),U,1)_" FILE (#"_+$P(X,"P",2)_")" D W1 G T
        !            17:        S W="***** TO A FILE THAT IS UNDEFINED *******" D W1
        !            18: T      ;
        !            19:        S W=0
        !            20: H      ;
        !            21:        W ! I $D(^DD(F(Z),D1,.1))#2 W ?(Z*2),^(.1),"   ",?M
        !            22:        I X["S" S N=$P(N,U,3) F I=1:1 S Y=$P(N,";",I) Q:Y=""  S W="'"_$P(Y,":")_"' FOR "_$P(Y,":",2)_";" W ?M,"  "_W,!
        !            23:        I $D(^DD(F(Z),D1,3))#2 S W=^(3) W ?M D W1
        !            24: RD     ;
        !            25:        I X S Z=Z+1,DDL1=DDL1+2,DDL2=DDL2+2,F(Z)=+X,W="   Multiple" D W1,L
        !            26: END    S X="" G:M'=U A:Z>1 Q
        !            27:        ;
        !            28: W1     W:$X+$L(W)+3>IOM !,?$S(IOM-$L(W)-5<M:IOM-5-$L(W),1:M),S S %Y=$E(W,IOM-$X,999) W $E(W,1,IOM-$X-1),S I %Y]"" S W=%Y G W1
        !            29:        D:$Y>IOSL HD Q
        !            30:        ;
        !            31: HD     S DC=DC+1 D ^DIDH
        !            32:        Q
        !            33: VP     ;Variable Pointer
        !            34:        W ?50,W S D1=DJ(Z)
        !            35: VP0    I '$D(^DD(F(Z),D1,"V",0)) S W="" Q
        !            36:        S DID1=0,DIMU=0,DID2=0 I '$D(DDRG) D RT
        !            37:        S W="FILE  ORDER  PREFIX    LAYGO  MESSAGE" W !?(Z+Z+12),W G Q:M=U
        !            38: VP1    S DID2=$O(^DD(F(Z),D1,"V",DID2)) S:DID2="" DID2=-1 G:DID2'>0 VP2 S DIDV=^(DID2,0) I '$D(^DIC(+DIDV,0)) S DIDV(+DIDV)=""
        !            39:        S DIVP=$P(DIDV,U),DDLF=(Z+Z+15) I $L(DIVP)>4 W !?(DDLF-$L(DIVP))+1,DIVP
        !            40:        E  W !?DDLF,DIVP
        !            41:        W ?(DDLF+5),$P(DIDV,U,3),?(DDLF+10),$P(DIDV,U,4),?(DDLF+23),$P(DIDV,U,6) S DDL3=DDL2,DDL2=DDLF+27,W=$P(DIDV,U,2) D W1^DIDH1 S DDL2=DDL3 S:$P(DIDV,U,5)["y" DIMU=1 D:$Y+4>IOSL HD G ND^DID1:M=U,VP1
        !            42: VP2    I DIMU S DIDVI=0 F  S DIDVI=$O(^DD(F(Z),D1,"V",DIDVI)) Q:DIDVI'>0  I $D(^(DIDVI,1)) S %=^(0) D VP3 Q:M=U
        !            43:        S DIDV=0 F  S DIDV=$O(DIDV(DIDV)) Q:DIDV'>0  S W="!! FILE "_DIDV_" DOES NOT EXIST !!" D W^DID1 Q:M=U
        !            44: Q      W ! K DID2,DIMU,DID1,DIDV,DIDVI S W="" Q
        !            45: VP3    ;
        !            46:        W !?(Z+Z+12),"SCREEN"_$S('$D(DINM):" ON FILE "_$P(%,U)_":",1:" EXPLANATION ON FILE "_$P(%,U)_":") S W=" "_$S('$D(DINM):^(1),1:$S($D(^(2)):^(2),1:"")) D W^DID1:'$D(DINM),W^DIDH:$D(DINM)
        !            47:        Q
        !            48: RT     F W="Required","Add New Entry without Asking","Multiply asked","audited" I X[$E(W,1) S W=" ("_W_")" W:($L(W)+$X)'<IOM ! D W^DID1 G ND^DID1:M=U
        !            49:        W ! I $D(^DD(F(Z),DJ(Z),.1)),^(.1)]"" W !?(Z+Z+12),^(.1),"   ",?M
        !            50:        Q
        !            51: AH     W !,"ALPHABETICALLY BY LABEL" D YN^DICN Q:%<0  S:%=1 DIDX=1,BY="@.01"
        !            52:        I '% W !?5,"Enter YES to list the fields ALPHABETICALLY BY LABEL.",!?5,"Enter NO to list the fields by NUMBER." S %=2 G AH
        !            53:        Q