Return to DICOMP.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DICOMP.m, revision 1.1

1.1     ! snw         1: DICOMP ;SFISC/GFT-EVALUATE COMPUTED FLD EXPR ;3/4/93  12:28 ;
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        S:$D(DICOMP)[0 DICOMP="" K K S K=0 F DLV=0:1 G A:'$D(J(DLV+1))
        !             5: EN1    ;
        !             6:        S K=0 F  S DLV=K,K=$O(I(K)) G K:K="",K:I'>0!'$D(J(K))!'$D(I(K\100*100))
        !             7: EN     ;
        !             8:        S DLV=+DICOMP
        !             9: K      K K S K=0 I DLV F I=0:100 Q:I>DLV  S K=K+1,K(K)="",K(K,1)=I
        !            10: A      K DICO S I=DLV F  S I=$O(J(I)),DICO(1)=DLV Q:I=""  K:DLV I(I),J(I)
        !            11:        S DPUNC=",'+-():[]!&\/*_=<>",DLV0=DLV\100*100,I=X,DIM=9.1,DIMW="" K X,DG,DIC,DATE,DPS,M,Y,W
        !            12:        S DIC(0)="ZFO",Q="""",(M,DPS,DBOOL)=0,DICO=I,DICO(1)=DLV,DICO(0)=DLV\100*100 F %=0:100 Q:'$D(J(%))  S DG(%)=%
        !            13:        G 0:" "[I!(+I=I)!(I'?.ANP)!(I?."?")!($E(I,$L(I))=":") I DPUNC[$E(I,1),$A(I)-40,$A(I)-39 G 0
        !            14: G      D I I X?.NP G:X="" N:I]"",^DICOMP1 I +X=X,X<1700!'$D(DATE(K-1))!'DBOOL G N:W'=":",N:$D(DPS(DPS,"$S"))
        !            15:        G E:$L(X)>30,FUNC:W="(",N:X?1"$"1U
        !            16: V      I $D(DICOMPX(X))#2 D DATE^DICOMP0:$D(DICOMPX(X,"DATE")) S T=X,X=DICOMPX(X) G N:'$D(DICOMPX(T,U)) S T=DICOMPX(T,U),DICN=$P(T,U,2),T=+T,Y(0)=^DD(T,DICN,0),D=$P(Y(0),U,2) D S^DICOMP0 G N
        !            17: E      K Y D ^DICOMP0 G 0:+X'=X&'$D(Y)
        !            18: N      ;
        !            19:        I X]"" S K=K+1,K(K)=X
        !            20:        S I=$E(I,M,999),M=0 G G:$F(DPUNC,W)<2
        !            21:        I W=":",'$D(DPS(DPS,"$S")) S I=$E(I,2,999) D I,M^DICOMPX,M^DICOMPW:$D(X) S W="" G N:$D(X),0
        !            22:        S X=W,W="",M=2 G N:X=""
        !            23:        G DPS:X=")",C:",:"[X,0:"+-'"[X&'$L($E(I,M,999)) I X="(" D ST G N
        !            24:        S DBOOL="><]['=!&"[X,Y="[]!&/\_><*=" G N:Y'[X I $E(I,M,999)_W]"",$D(K(K)),")'"[K(K)!'$F(DPUNC,K(K)),$F(Y,W)<2 G N:K(K)'="'" S K(K)="'"_X,X="" G N:DBOOL
        !            25: 0      G 0^DICOMP1
        !            26:        ;
        !            27: I      I $A(I,M+1)=34 S M=$F(I,Q,M+2)-1 G I:M>0 S W=0,M=999,X=U Q
        !            28: MR     F M=M+1:1 S W=$E(I,M) Q:DPUNC[W
        !            29:        S X=$E(I,1,M-1) Q
        !            30:        ;
        !            31: C      I DICO["SETDATA(" D SD^DICOMPZ G Q^DICOMP1:'$D(X)
        !            32:        S DICF=X D DG S K(K+1,2)=0
        !            33:        I $O(DPS(DPS,"$"))["$" S DPS(DPS)=DPS(DPS)_Y_DICF G N
        !            34:        G 0:'$D(W(DPS)) S (W,W(DPS))=W(DPS)-1 K:W<2 W(DPS) S DPS(DPS)=" S X"_W_"="_Y_DPS(DPS) G N
        !            35:        ;
        !            36: DPS    I DPS D DPS^DICOMPW G N:'$D(W(DPS+1))
        !            37:        G 0
        !            38:        ;
        !            39: FUNC   S Y=$O(^DD("FUNC","B",X,0)) S:Y="" Y=-1 I '$D(^DD("FUNC",Y,0)),X'?1N.N2A,X'?1"$"1U G V
        !            40:        S DICF=X D ST I $D(^(1)) D 1 G B
        !            41:        I DICF'?1"$"1U.U D ^DICOMPX S W="" G DPS:DPS,0
        !            42:        S DPS(DPS,DICF)=DPS(DPS),DPS(DPS)=" S X="_DICF_W
        !            43: B      S M=M+1,W="" G 0:$E(I,M)=")",N
        !            44:        ;
        !            45: 2      ;
        !            46:        D ST
        !            47: 1      G ARG^DICOMPZ
        !            48:        ;
        !            49: ST     ;
        !            50:        S DPS=DPS+1,%="",Y=K
        !            51: S      I 'Y S X="",DPS(DPS)=$P(" S X="_%_"X",U,%]"") Q
        !            52:        I K(Y)="" S Y=Y-1 G S
        !            53:        I "'"[K(Y)!(K(Y)="+"),$S(Y=1:1,1:K(Y-1)?1P!(K(Y-1)="")) S %=K(Y)_%,K=K-1,Y=Y-1 G S
        !            54:        D DG S DPS(DPS)="" I K(K)?1P!(K(K)?2P) S DPS(DPS)=" S Y="_%_"X,X="_Y_",X=X",DPS(DPS,U)=K(K)_"Y",K=K-1
        !            55:        S:$D(DATE(K)) DPS(DPS,"DATE")=1 S:DBOOL DBOOL=0,DPS(DPS,"BOOL")=1
        !            56:        S K(K+1,2)=0 Q
        !            57:        ;
        !            58: DG     S (Y,DG(DLV0))=DG(DLV0)+1,Y=DQI_Y_")",X=" S "_Y_"=X"