Return to DICATT22.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DICATT22.m, revision 1.1

1.1     ! snw         1: DICATT22       ;SFISC/GFT-CREATE A SUBFILE ;10/6/94  13:05
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        G M:V I P,$D(^DD(J(N-1),P,0)) S I=A_$E("I",$P(^(0),U,2)["I") D P
        !             5:        I O,DA=.01,'N S I=$P(@(I(0)_"0)"),U,2) D P
        !             6: 1      ;
        !             7:        S %=$L(F)+$L(W)+$L(C)+$L(Z) I %>242 W $C(7),!?5,"Field Definition is TOO LONG by ",%-242," characters!" G TYPE^DICATT2
        !             8:        I T["P",$D(O)=11,+$P($P(O(1),U,2),"P",2)'=+$P(Z,"P",2) S X=$P(O(1),U,2),DA(1)=A X:$D(^DD(0,.2,1,3,2)) ^(2)
        !             9:        S ^DD(A,DA,0)=F_U_Z_U_W_U_C S:$P(Z,U)["K" ^(9)="@" D SDIK,I G N^DICATT
        !            10:        ;
        !            11: Q      W $C(7),!,"NUMBER MUST BE BETWEEN ",A," & ",%+1," AND NOT ALREADY IN USE"
        !            12: M      S %=$P(A,".",1),DE=%_"."_+$P(A,".",2)_DA I +DE'=DE!$D(^DD(DE)) F DE=A+.01:.01:%+.7,%+.7:.001:%+.9,%+.9:.0001 Q:DE>A&'$D(^DD(DE))
        !            13:        I DUZ(0)="@" W !,"SUB-DICTIONARY NUMBER: "_DE_"// " R DG:DTIME S:'$T DTOUT=1 G:DG=U!'$T ^DICATT2 S:DG]"" DE=DG G Q:+DE'=DE!(DE<A)
        !            14:        G Q:%+1'>DE!$D(^DD(DE)) S I=DE,^(I,0)=F_" SUB-FIELD^^.01^1",^(0,"UP")=A,^("NM",F)="",^DD(A,DA,0)=F_"^^^"_W D P S:T["V" %X="^DD("_A_","_DA_",""V"","
        !            15:        S W=$P(W,S,1) D SDIK S:+W'=W W=Q_W_Q
        !            16:        S (N,DICL)=N+1,I(N)=W,J(N)=DE,DA=.01,^DD(DE,DA,0)=F_U_Z_"^0;1^"_C I T["V" S %Y="^DD("_DE_",.01,""V""," D %XY^%RCR K @($E(%X,1,$L(%X)-1)_")"),%X,%Y I $D(^DD(DE,DA,0))
        !            17:        I T'["W" S ^(1,0)="^.1",^(1,0)=DE_"^B",DIK=W_",""B"",$E(X,1,30),DA)" F %=DICL-1:-1 S DIK=I(%)_$E(",",1,%)_"DA("_(DICL-%)_"),"_DIK I '% S ^(1)="S "_DIK_"=""""",^(2)="K "_DIK S:T["V" ^(3)="Required Index for Variable Pointer" Q
        !            18:        D SDIK,I S DICL=DICL-1 G N^DICATT
        !            19:        ;
        !            20: I      I $P(O,U,2,99)'=$P(^DD(J(N),DA,0),U,2,99) S:$D(M)#2 ^(3)=M S M(1)=0,^("DT")=DT,^DD(J(N),0,"DT")=DT F DR=J(N):0 Q:'$D(^DD(DR,0,"UP"))  S DR=^("UP"),^DD(DR,0,"DT")=DT
        !            21:        K DR,DG,DB,DQ,DQI,^DD(U,$J),^UTILITY("DIVR",$J)
        !            22:        S DIE=DIK,DR=$S(DUZ(0)="@":"3;4",1:3)_$P(";21",U,'O) D DIE I T="W" K DE
        !            23:        I $D(M)>9,O S V=DICL,DR=$P(Z,U,1),Z=$P(Z,U,2) I @("$O("_I(0)_"0))>0") D V S:'$D(DA) DA=DIFLD
        !            24:        K DR,M Q
        !            25:        ;
        !            26: DIE    ;
        !            27:        N I,J
        !            28:        D ^DIE
        !            29:        Q
        !            30:        ;
        !            31: V      S DI=J(N) D DIPZ^DIU0 Q:T="W"!$D(DTOUT)!'$D(DIZ)
        !            32:        W !!,"SINCE YOU HAVE CHANGED THE FIELD DEFINITION,",!,"EXISTING '",F,"' DATA WILL NOW BE CHECKED FOR INCONSISTENCIES",!,$C(7),"OK"
        !            33:        S %=1 D YN^DICN Q:%-1  S DDC=C,$P(Y(0),U,4)=W,DIFLD=D0,Z=$P(DIZ,U,2),DR=$P(DIZ,U) G ^DIVR
        !            34:        ;
        !            35: P      F Y="S","D","P","A","V" S:I[Y I=$P(I,Y,1)_$P(I,Y,2)_$P(I,Y,3) S:T[Y I=I_Y
        !            36:        S ^(0)=$P(^(0),U,1)_U_I_U_$P(^(0),U,3,99) Q
        !            37:        ;
        !            38: SDIK   S DA(1)=J(DICL),DIK="^DD("_DA(1)_"," I O K ^DD(DA(1),"RQ",DA)
        !            39:        W !,"...." G IX1^DIK