Return to DDSCOMP.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DDSCOMP	;SFISC/MKO-EVALUATE COMPUTED EXPRESSIONS ;09:23 AM  23 Nov 1994
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	;
    5: PARSE(DDP,EXP,BK,NEXP,AR,FDL)	;Parse the computed expression EXP
    6: 	;Returns:
    7: 	;  NEXP = EXP with {expr} replaced with DDSE(n)
    8: 	;  AR   = array when executed sets DDSE(n)
    9: 	;  FDL  = list of fields referenced
   10: 	N I,J,N,ST
   11: 	;
   12: 	S NEXP="",(N,AR)=0,ST=1
   13: 	S I=0 F  D  Q:'I!$G(DIERR)
   14: 	. S I=$$FIND^DDSLIB(EXP,"{",I) Q:'I
   15: 	. S N=N+1
   16: 	. S NEXP=NEXP_$E(EXP,ST,I-2)_"DDSE("_N_")"
   17: 	. S ST=$$FIND^DDSLIB(EXP,"}",I)
   18: 	. D EVAL(DDP,$E(EXP,I,ST-2),BK,N,.AR,.FDL) Q:$G(DIERR)
   19: 	. S I=ST
   20: 	Q:$G(DIERR)
   21: 	S NEXP=$S(EXP?1"=".E:"S Y",1:"")_NEXP_$E(EXP,ST,999)
   22: 	;
   23: 	S AR=N
   24: 	S:$G(FDL)]"" FDL=$E(FDL,1,$L(FDL)-1)
   25: 	Q
   26: 	;
   27: EVAL(DDP,EXP,BK,N,AR,FDL)	;Evaluate field expression
   28: 	;In:
   29: 	;  EXP = computed expr
   30: 	;  N   = expr number -- index into DDSE()
   31: 	;Out:
   32: 	;  AR  = array of code that sets DDSE(n)
   33: 	;  FDL = list of fields used in expr
   34: 	;
   35: 	N CD
   36: 	D:EXP?1"FO(".E FO^DDSPTR(DDP,EXP,"","",BK,.CD,.FDL,1)
   37: 	D:EXP'?1"FO(".E DD^DDSPTR(DDP,EXP,"",.CD,.FDL,1)
   38: 	Q:$G(DIERR)
   39: 	;
   40: 	I CD=1 S AR(N)="N X "_CD(1)_",DDSE("_N_")=X"
   41: 	E  D
   42: 	. F CD=1:1:CD S AR(N,CD)=CD(CD)
   43: 	. S AR(N,CD)=AR(N,CD)_",DDSE("_N_")=X"
   44: 	. S AR(N)="N DDSI,X S DDSE("_N_")="""" F DDSI=1:1:"_CD_" Q:DDSI>1&($G(X)'>0)!'$D(*DDSREFC*,DDSI))  X ^(DDSI)"
   45: 	Q
   46: 	;
   47: RPCF(DDSPG)	;Repaint computed fields
   48: 	;Called from ^DDS01 and ^DDSVALF when value used in
   49: 	;computed expression changes
   50: 	N DDSCBK,DDSCDDO
   51: 	;
   52: 	S DDSCBK="" F  S DDSCBK=$O(@DDSREFS@("COMP",DDP,DDSFLD,DDSPG,DDSCBK)) Q:DDSCBK=""  D
   53: 	. N DA
   54: 	. D GETDA(DDSPG,DDSCBK,.DA)
   55: 	. S DDSCDDO="" F  S DDSCDDO=$O(@DDSREFS@("COMP",DDP,DDSFLD,DDSPG,DDSCBK,DDSCDDO)) Q:DDSCDDO=""  D RPCF1
   56: 	;
   57: 	Q
   58: 	;
   59: RPCF1	;
   60: 	N DDSC,DDSE,DDSLEN,DDSX
   61: 	S DDSC=$G(@DDSREFS@(DDSPG,DDSCBK,DDSCDDO,"D")) Q:DDSC=""
   62: 	S DDSX=$$VAL(DDSCDDO,DDSCBK)
   63: 	;
   64: 	S DY=+DDSC,DX=$P(DDSC,U,2),DDSLEN=$P(DDSC,U,3)
   65: 	I $P(DDSC,U,10) S DDSX=$J("",DDSLEN-$L(DDSX))_$E(DDSX,1,DDSLEN)
   66: 	E  S DDSX=$E(DDSX,1,DDSLEN)_$J("",DDSLEN-$L(DDSX))
   67: 	X IOXY
   68: 	W $P(DDGLVID,DDGLDEL)_DDSX_$P(DDGLVID,DDGLDEL,10)
   69: 	;
   70: 	N DDP,DDSFLD
   71: 	S DDP=0,DDSFLD=DDSCDDO_","_DDSBK
   72: 	D:$D(@DDSREFS@("COMP",DDP,DDSFLD,DDSPG)) RPCF(DDSPG)
   73: 	;
   74: 	Q
   75: 	;
   76: GETDA(P,B,DA)	;Get DA array of block
   77: 	S DA=$G(@DDSREFT@(P,B)) Q:DA=""  Q:'$G(^(B,DA))
   78: 	F I=2:1:$L(DA,",")-1 S DA(I-1)=$P(DA,",",I)
   79: 	S DA=+DA
   80: 	Q
   81: 	;
   82: VAL(DDSDDO,DDSBK,DDSDA)	;Return value of computed field
   83: 	N DDSE,DDSX,Y
   84: 	I $D(DDSDA) N DA D DA(DDSDA,.DA)
   85: 	S DDSX=0 F  S DDSX=$O(@DDSREFS@("COMPE",DDSBK,DDSDDO,DDSX)) Q:DDSX=""  X ^(DDSX)
   86: 	K Y X $G(@DDSREFS@("COMPE",DDSBK,DDSDDO))
   87: 	Q $G(Y)
   88: 	;
   89: DA(DDSDA,DA)	;Return DA array based on DDSDA
   90: 	N I
   91: 	S DA=$P(DDSDA,",")
   92: 	F I=2:1:$L(DDSDA,",") S DA(I-1)=$P(DDSDA,",",I)
   93: 	Q