Return to DICATT22.m CVS log

Up to [Coherent Logic Development] / freem_fileman

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