Return to DICOMPY.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DICOMPY.m, revision 1.1

1.1     ! snw         1: DICOMPY        ;SFISC/GFT-EVALUATE COMPUTED FLD EXPR ;2/18/93  15:00 ;
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        G BAD:'$D(X) S DG(DLV0)=DG(DLV0)+1,DICN=DQI_DG(DLV0)_")",W=DLV#100,K=K+2,%="D"_W,K(K)=" S "_DICN_"=""""",J=" X ""F "_%_"=0:0 S "_%_"=$O("_X_%_")) Q:"_%_"'>0  "
        !             5:        S DIC("S")="I '$P(^(0),U,2)",DIC="^DD("_J(DLV)_",",D=M,M=$F(I,")")-1,X=$E(I,D+1,M-1) G BAD:M<1 S:X?1"#".NP X=$E(X,2,9) S:X="" X=.01
        !             6:        I X="NUMBER" S D=%,%=W,W=D,D=$S($D(^DD(J(DLV),.001,0)):$P(^(0),U,2),1:"") G NUMBER
        !             7:        D DICS,^DIC G BAD:Y<0
        !             8:        S T=+Y,%=DLV-DLV0,D=$P(Y(0),U,2) I D["C" S W="X",J=J_"X $P(^DD("_J(DLV)_","_T_",0),U,5,99) " G NUMBER
        !             9:        D W I X="" S W="D"_%
        !            10:        E  S:+Y'=Y Y=Q_Q_Y_Q_Q S W="$S($D(^(D"_%_","_Y_")):",Y="(^("_Y_")," D EP S W=W_X_",1:"""""""")"
        !            11: NUMBER I DICF S DG(DLV0)=DG(DLV0)+1,%X=DQI_DG(DLV0)_")",K(K)=" S X=0,"_%X_"=0"_K(K) D L S W=W_" "_%X_"="_%X_"+1 I "_%X_"="_+DICF_" S "_DICN_"=Y Q",DPS(DPS,"O")=""
        !            12:        E  D @DICF
        !            13:        I $D(DICOMPX)#2 S %X=J(DLV)_U_T_$E(";",1,$L(DICOMPX)) S:";"_DICOMPX_";"'[(";"_%X) DICOMPX=%X_DICOMPX
        !            14:        S W=W_""" S "_$S($D(DICOMPX(0)):"("_DICOMPX(0)_%_"),D("_%_")",1:"D("_%)_")=D"_%
        !            15:        I DICF="COUNT" S DICN="+"_DICN
        !            16:        S K=K+1,K(K)=J_W,K(K,2)=0,K=K+1,K(K)=DICN,M=M+1 I "TOTAL"=DICF!$T K DATE(K-2) Q
        !            17:        Q:$D(DPS(DPS,"INTERNAL"))  I D["O",$D(^DD(J(DLV),T,2)) S K=K+1,K(K)=" S Y=X "_^(2),K(K,2)=0,K=K+1,K(K)="Y" Q
        !            18:        S:D["D" DATE(K)=1 S X="X",DICN=T,T=J(DLV) D S^DICOMP0 Q:X="X"
        !            19:        S K(K,2)=0,K=K+1,K(K)=X Q
        !            20:        ;
        !            21: W      S X=$P(Y(0),U,4),Y=$P(X,";",1),X=$P(X,";",2) Q
        !            22:        ;
        !            23: DICS   ;
        !            24:        S:DUZ(0)'="@" D=DICOMP["W"+8,DIC("S")=DIC("S")_" Q:'$D("_DIC_"Y,"_D_"))  F %=1:1:$L(^("_D_")) I DUZ(0)[$E(^("_D_"),%) Q" Q
        !            25: G      ;
        !            26:        D W I X="" S Y=T#100,X=$S(T<DLV0&$D(M(Y,T))!(DICOMP["T"&(T<DICO(0))):$S(DA:DQI_(T+80)_")",1:"I("_T_",0)"),1:"$S('$D(D"_Y_"):"""",D"_Y_"<0:"""",1:D"_Y_")") Q
        !            27:        I '$D(DG(%,T_U_Y)) S (DG(%),DG(%,T_U_Y))=DG(%)+1
        !            28:        S Y="("_DQI_DG(%,T_U_Y)_"),"
        !            29: EP     I X S X="$P"_Y_"U,"_X_")" Q
        !            30:        I X?1"E".E S X="$E"_Y_+$E(X,2,9)_","_$P(X,",",2)_")"
        !            31:        Q
        !            32:        ;
        !            33: BAD    S DPS=0 Q
        !            34:        ;
        !            35: PREVIOUS       S W="I $O("_V_"D"_%_"))=I("_DLV_",0) S "_DICN_"="_W_" Q" Q
        !            36: NEXT   S X=" S D"_%_"=+$O("_V_"D"_%_")) " I D["C" S X=X_"X $P(^"_$P(J,"X $P(^",2)
        !            37:        S J=X_"S "_DICN_"=",W=W_" S:D"_%_"'>0 D"_%_"=-1,"_DICN_"=""" Q
        !            38: MAXIMUM        S %X="'>" G MM
        !            39: MINIMUM        S %X="'<"
        !            40: MM     D L S W=W_"&("_DICN_%X_"Y!'$L("_DICN_")) "_DICN_"=Y" Q
        !            41: TOTAL  S W="S "_DICN_"="_DICN_"+"_W Q
        !            42: COUNT  S W=$S($P(Y(0),U,2)["W":"S ",1:"S:"_W_"'?."""" """" ")_DICN_"="_DICN_"+1" Q
        !            43: LAST   D L S W=W_" "_DICN_"=Y" Q
        !            44: L      S W="S Y="_W_" S:Y'?."""" """"" S:D["D" DPS(DPS,"DATE")=1
        !            45:        Q