Return to DICOMPY.m CVS log

Up to [Coherent Logic Development] / freem_fileman

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