Return to DICOMP0.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DICOMP0.m, revision 1.1.1.1

1.1       snw         1: DICOMP0        ;SFISC/GFT-EVALUATE COMPUTED FLD EXPR ;2/17/93 12:38 ;
                      2:        ;;21.0;VA FileMan;;Dec 28, 1994
                      3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
                      4:        I DPS,$D(DPS(DPS,"SET")),'$D(W(DPS)) S T="""",D=$P(X,T,1)_$P(X,T,2) G BAD:$L(D)+2\5-1!(D'?.UN)!(D?1"D".E)!(DUZ(0)'="@") S X=T_D_T,DICOMPX(D)=D,Y=0 Q
                      5:        I X?1"""".E1"""" S Y=0,%=$E(X,2,$L(X)-1) K:%[""" X "!(%[""" D @") Y Q
                      6: L      S T=DLV,DICN=X G M:'$D(J(T))
                      7: TRY    S DIC="^DD("_J(T)_",",DG=$O(^DD(J(T),0,"NM",0))_" ",DIC("S")=$S(W="["!($E(I,M,M+1)="'[")!$D(DICMX):"I 1",1:"S %=$P(^(0),U,2) I '%,%'[""m""")_$P(",Y-DA",U,DICO(1)=T&DA) D DICS^DICOMPY:DUZ(0)'="@"
                      8: R      I X?1"#"1NP.NP S X=$E(X,2,99) D ^DIC G:Y>0 A:DLV,X S X="#"_X
                      9:        D ^DIC G A:Y>0
                     10: N      I $P(X,DG,1)="",X=DICN S X=$P(X,DG,2,9) G R
                     11:        I X="NUMBER" S Y=.001,Y(0)=0 G D
                     12:        S T=T-1,X=DICN G M:T<0,TRY:$D(J(T)) F T=T-99:1 G TRY:'$D(J(T+1))
                     13: A      F D=M:1:$L(I)+1 Q:$F(X,$E(I,1,D))-1-D  S W=$E(I,D+1)
                     14:        I DICOMP["?",DICN'="#.01",$P(Y,U,2)'=DICN,DG_$P(Y,U,2)'=DICN W !?3,"By '"_DICN_"', do you mean "_DG_"'"_$P(Y,U,2)_"'" S %=1 D YN^DICN G BAD:%<0,N:%-1
                     15:        S M=D
                     16: X      I $D(DICOMPX)#2 S %Y=J(T)_U_+Y_$E(";",1,$L(DICOMPX)) S:";"_DICOMPX_";"'[(";"_%Y) DICOMPX=%Y_DICOMPX
                     17: D      S D=$P(Y(0),"^",2),%=T\100*100,DICN=+Y D DATE:D["D"&'$D(DPS(DPS,"INTERNAL"))
                     18:        I D["m"!D G MUL^DICOMPZ
                     19:        I $D(DICOMPX(1,J(T),+Y)) S X=DICOMPX(1,J(T),+Y) G O
                     20:        I D["C" S:'$D(DG(%,T,+Y)) DG(%)=DG(%)+1,DG(%,T,+Y)=DG(%) S X=DQI_DG(%,T,+Y)_")" Q
                     21:        D G^DICOMPY
                     22: O      Q:W=")"&$D(DPS(DPS,"INTERNAL"))  S T=J(T)
                     23: S      ;
                     24:        S %=DLV0,DG=W=":"&'$D(DPS(DPS,$S)) I D["O",D'["P"!'DG,$D(^DD(T,DICN,2)) S DICF=X D ST^DICOMP S K=K+2,K(K-1)=X,K(K)=" S Y="_DICF_" X:$D(^DD("_T_","_DICN_",2)) ^(2) S X=Y" G DPS^DICOMPW
                     25:        I D["S" S DG(%)=DG(%)+1,DG(%,DG(%))="$C(59)_$S($D(^DD("_T_","_DICN_",0)):$P(^(0),U,3)",X="$P($P("_DQI_DG(%)_"),$C(59)_"_X_"_"":"",2),$C(59),1)"
                     26:        I D["V",'$D(DPS(DPS,"FILE")) S X=X_",C=$S(X="""":-1,'$D(@(U_$P(X,"";"",2)_""0)"")):-1,1:$P(^(0),U,2)),X=$S(X="""":X,'$D(^(+X,0)):"""",1:$P(^(0),U,1)),Y=X,C=$S($D(^DD(+C,.01,0)):$P(^(0),U,2),1:""D"") D:X]"""" Y^DIQ:C'[""D"" S X=Y,C="","""
                     27:        Q:D'["P"  S %Y=U_$P(Y(0),U,3),DICN=+$P(@(%Y_"0)"),U,2)
                     28:        I DG,$D(^DIC(DICN,0)) D DRW^DICOMPX S %1=Y,Y=DICN X:$D(^DIC(Y,0)) DIC("S") S Y=%1 K %1 G MR:'$T
                     29:        I 'DG S D=$S($D(^DD(DICN,.01,0)):$P(^(0),U,2),1:"") I D'["V",D'["S",D'["P" D DATE:D["D" S X="$S('$D("_%Y_"+"_X_",0)):"""",1:$P(^(0),U,1))" Q
                     30: P      G P^DICOMPX
                     31:        ;
                     32: M      S T=$F(X," IN ") I T S X=$E(X,1,T-5),W=":",M=T-4,I=X_W_$E(I,T,999),T=$F(I," FILE",M) S:T&$F(DPUNC,$E(I,T)) I=$E(I,1,T-6)_$E(I,T,999) G DICOMP0
                     33:        G MR:$L(X)>30 S DICF=X,T=$O(^DD("FUNC","B",X,0)) I T'="",$D(^DD("FUNC",T,3)),^(3)?1"0".E,$D(^(1)) D 2^DICOMP S Y(0)=0,K=K+1,K(K)=X D DATE:$S($D(^(2)):^(2)?1"D".E,1:0),DPS^DICOMPW Q
                     34:        S T=-1,%DT="T" D ^%DT I Y>0 S X=Y,Y(0)=0 G DATE
                     35:        S T=$O(^DIC("B",X)) S:T="" T=-1 I $P(T,X,1)=""!$D(^(X)) S T=DLV0 D ^DICOMPV I D>0 G P:D=.01 Q
                     36: MR     I M'>$L(I),+X'=X D MR^DICOMP G L
                     37: BAD    K Y Q
                     38:        ;
                     39: DATE   S DATE(K+1)=1