Return to DICATT3.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DICATT3.m, revision 1.1.1.1

1.1       snw         1: DICATT3        ;SFISC/XAK-COMPUTED FIELDS ;1/11/91  2:21 PM
                      2:        ;;21.0;VA FileMan;;Dec 28, 1994
                      3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
                      4: 6      W !!,"'COMPUTED-FIELD' EXPRESSION: " I O,$D(^DD(A,DA,9.1)) S (X,Y)=^(9.1),%=$L(X)>19 W X W:'% "// " I % D RW^DIR2 W ! G 61
                      5:        R X:DTIME,! S:'$T X=U,DTOUT=1
                      6: 61     K DICOMPX S DICOMPX="" I U[X G:X=U N^DICATT:O,CHECK^DICATT G 6:'O D DEC:$P($P(O,U,2),"J",1)="C" G N^DICATT
                      7:        G DICATT3^DIQQ:X?."?" S Z=X,DQI="Y("_A_","_DA_",",DICMX="X DICMX",DICOMP="?I"
                      8:        D ^DICOMP I '$D(X) W $C(7),"  ...",I,"??" G 6
                      9:        I DUZ(0)="@" W !,"TRANSLATES TO THE FOLLOWING CODE:",!,X,!
                     10:        I Y["m" W !,"FIELD IS 'MULTIPLE-VALUED'!",!
                     11:        I O,$D(^DD(A,DA,9.01))!(DICOMPX]"") D ACOMP
                     12:        S (Y,DATE)=$E("D",Y["D")_$E("B",Y["B")_"C"_$S(Y'["m":"",1:"m"_$E("w",Y["w")),^DD(A,DA,0)=F_U_Y_"^^ ; ^"_X,^(9)=U,^(9.1)=Z,^(9.01)=DICOMPX
                     13:        F Y=9.2:.1 Q:'$D(X(Y))  S ^(Y)=X(Y)
                     14:        K X,DICOMPX D SDIK^DICATT22:'O,DEC:DATE="C" I O S DI=A D PZ^DIU0
                     15:        K DATE G N^DICATT
                     16:        ;
                     17: ACOMP  ;SET/KILL ACOMP NODES
                     18:        N X,I I $D(^DD(A,DA,9.01)),^(9.01)]"" S X=^(9.01) X ^DD(0,9.01,1,1,2)
                     19:        I DICOMPX]"" S X=DICOMPX X ^DD(0,9.01,1,1,1)
                     20:        Q
                     21: DEC    S C=$P(^DD(A,DA,0),U,2),Y="",Z=$P(C,"J",2) F J=0:0 S N=$E(Z,1) Q:N?.A  S Z=$E(Z,2,99),Y=Y_N
                     22:        W !,"NUMBER OF FRACTIONAL DIGITS TO OUTPUT (ONLY ANSWER IF NUMBER-VALUED): " S N=$P(Y,",",2),E=$S(Y:+Y,1:8) I N]"" W N,"// "
                     23:        R DG:DTIME S:'$T DTOUT=1 Q:DG[U!'$T  S N=$S(DG="":N,DG="@":"",1:DG) G S:N="",DICATT31^DIQQ:N'?1N
                     24:        I C?1"D".E S C=$E(C,2,99),^(0)=$P(^(0),U,1)_U_C_U_$P(^(0),U,3,99)
                     25:        S DG=" S X=$J(X,0,",M=$P(^(0),DG,1),%=M_DG_N_")"'=^(0)+1 W !,"SHOULD VALUE ALWAYS BE INTERNALLY ROUNDED TO ",N," DECIMAL PLACE",$E("S",N'=1) D YN^DICN G DEC:'% Q:%'>0  S ^(0)=M_$P(DG_N_")",U,%)
                     26: S      S DQI="Y(",O=$D(^(9.02)),X=^(9.1) K DICOMPX,^(9.02) G J:'$D(^(9.01))
                     27:        F Y=1:1 S M=$P(^(9.01),";",Y) Q:M=""  S DICOMPX(1,+M,+$P(M,U,2))="S("""_M_""")",DICOMPX=""
                     28:        G J:Y<2 I X'["/",X'["\" G J:X'["*",J:Y<3
                     29:        D ^DICOMP G J:$D(X)-1
                     30:        S %=2-O W !,"WHEN TOTALLING THIS FIELD, SHOULD THE SUM BE COMPUTED FROM",!?7,"THE SUMS OF THE COMPONENT FIELDS" D YN^DICN
                     31:        I %=1 S ^DD(A,DA,9.02)=X_" S Y=X"
                     32: J      K DICOMPX Q:$D(DTOUT)  W !,"LENGTH OF FIELD: ",E,"// " R DG:DTIME S:'$T DTOUT=1 Q:DG[U!'$T  I DG,DG\1=DG S E=DG G 0
                     33:        I DG]"" W !,"MAXIMUM NUMBER OF CHARACTERS" G J
                     34: 0      S ^(0)=$P(^DD(A,DA,0),U,1)_U_$P(C,"J",1)_"J"_E_$E(",",N]"")_N_Z_U_$P(^(0),U,3,99)