Return to DICOMP1.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DICOMP1	;SFISC/GFT-EVALUATE COMPUTED FLD EXPR ;2/17/93 12:45 ;
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	G 0:DPS
    5: 	I DICO["SETDATA(" S K=K+1,K(K)=DICF(1)_",DIC(DIG)=X D SD^DICR S X="""" K DIC"
    6: 	S DG=-1,T=99,M=DIM,DLV0=0,X="",K=1,W=0 K DIM
    7: ST	S DG=$O(DG(DLV0,DG)),Y=$P(DG,U,2) I DG="" D EX S DG=-1,W=0 G NN
    8: 	I Y]"" S:+Y'=Y Y=Q_Y_Q S I=DQI_DG(DLV0,DG)_")=$S($D(^(" D X:T-DG!(DG<DLV0) S I=I_Y_")):^("_Y_")" G 9
    9: C	S %=$O(DG(DLV0,DG,0)) S:%="" %=-1 I %>0 S I=" X $P(^DD("_J(DG)_","_%_",0),U,5,99) S "_DQI_DG(DLV0,DG,%)_")=X" D EX:W,M:$L(X)+$L(I)>180 S X=X_I K DG(DLV0,DG,%) G C
   10: 	G ST:$D(DG(DLV0,DG))[0 S I=DG(DLV0,DG) I I?.N S I=$S(DA:DQI_(DLV0+I+80),1:"I("_(DLV0+I)_",0")_")=$S($D(D"_I_"):D"_I
   11: 	E  S I=DQI_+DG_")="_I
   12: 	K DG(DLV0,DG) G OV:DG?.N1A
   13: 9	S I=I_",1:"""")" I $D(DICV),DICV["V" S I=I_"_$C(59)_"""_$E(I(0),2,99)_""""
   14: OV	I $L(I)+$L(X)>180 D M
   15: 	S:'W X=X_" S " S X=X_I_",",W=2 G ST
   16: 	;
   17: X	S I=$P(I,U),%=DG\100*100 F T=0:1:DG#100 S I=I_I(%)_$E(",",1,T)_$S(DICOMP["T"&(DG<DICO(0)):"I("_%_",0)",1:"D"_T)_",",%=%+1
   18: 	K DG(DLV0,DG) Q
   19: 	;
   20: NN	I $D(K(K,1)) S W=0,DLV0=K(K,1),DG=-1 K K(K,1) G ST
   21: 	I $D(K(K,9)) F %=1:1:K K DATE(%)
   22: 	G S:$D(K(K))[0 I " "[$E(K(K),1) G K1:K(K)="",1:X="",AS:$P(K(K)," S ",1)="" D EX:W,M:$L(X)+$L(K(K))>180 G 1
   23: 	I 'W D M:$L(X)+$L(K(K))>165 S X=X_" S X=",W=6
   24: 1	G P:K(K)?1P,A:'$D(DATE(K)) S Y=1 I K>1,K(K-1)="+" S X=X_"0,X2=X,X1="_K(K) G DTC
   25: 2	G A:'$D(K(K+2)) K DATE(K) I '$D(DATE(K+2)),$F("+-",K(K+1))>1 S X=X_K(K)_",X1=X,X2="_K(K+1)_K(K+2),DATE(K+2)=1
   26: 	E  G A:K(K+1)'="-" K DATE(K+2) S X=X_K(K)_",X1=X,X2="_K(K+2),Y=0
   27: 	S K=K+2
   28: DTC	S K=K+1,X=X_",X="""" D"_$P(":X2 ^ C",U,Y+1)_"^%DTC:X1" G S:'$D(K(K)) D SX G NN:'Y S K=K-1,K(K)="" G 2
   29: 	;
   30: P	I "\/"[K(K),$D(K(K+1)),K(K+1)'?.NP S K=K+1,K(K)=",X=$S("_K(K)_":X"_K(K-1)_K(K)_",1:""*******"")"
   31: 	I $L(X)>150,$F(DPUNC,K(K))>3 D M,SX
   32: A	S W='$D(K(K,2)),X=X_K(K)
   33: K1	S K=K+1 G NN:$D(K(K))#2
   34: S	S I="" F  S I=$O(M(I)),W=0 Q:I=""  D M:$L(X)>235 S K=$O(M(I,"")),X=X_" S D"_I_"="_$S(DA:DQI_(K+80),1:"I("_K_",0")_")"
   35: 	S I=-1 D SS S:X?.E1" S X=X" X=$E(X,1,$L(X)-6) I X'?1"S X="1N.NP G Q
   36: 0	;
   37: 	S DICOMP="",DLV=DICO(1) K X,DIM,DATE I DICO[" ",DUZ(0)="@" S X=DICO,DIM=1 D ^DIM
   38: Q	I DICOMP'["S" S K=DICO(1) F  S K=$O(I(K)) Q:K=""  K I(K),J(K)
   39: 	K Y S Y=DLV_$E("W",$D(DPS("W")))_DIMW_$E("D",$D(DATE)>9)_$E("B",DBOOL)_$E("X",$D(DIM))_$E("L",$D(DICO(2)))
   40: 	K V,K,W,T,M,DG,DIM,DICN,DICF,DICV,DLV,DPS,DIC,DICOMP,DBOOL,DICO,DLV0,DPUNC,DICMX,DIMW Q
   41: 	;
   42: 	;
   43: EX	S X=$E(X,1,$L(X)-W+1) Q
   44: 	;
   45: AS	D EX I $L(K(K))+$L(X)<160 S K(K)=$E(K(K),4,999),X=X_","
   46: 	E  D M
   47: 	G 1
   48: 	;
   49: M	D SS,EX S M=M+.1,X(M)=X,X="X "_$S(DA:"^DD("_A_","_DA_",",1:DA)_M_")",W=0 Q
   50: 	;
   51: SS	S:$A(X)=32 X=$E(X,2,999) Q
   52: 	;
   53: SX	S X=X_" S X=X",W=1
   54: 	Q