Return to DICOMP1.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DICOMP1.m, revision 1.1.1.1

1.1       snw         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