Return to DDSCOMP.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

DDSCOMP	;SFISC/MKO-EVALUATE COMPUTED EXPRESSIONS ;09:23 AM  23 Nov 1994
	;;21.0;VA FileMan;;Dec 28, 1994
	;Per VHA Directive 10-93-142, this routine should not be modified.
	;
PARSE(DDP,EXP,BK,NEXP,AR,FDL)	;Parse the computed expression EXP
	;Returns:
	;  NEXP = EXP with {expr} replaced with DDSE(n)
	;  AR   = array when executed sets DDSE(n)
	;  FDL  = list of fields referenced
	N I,J,N,ST
	;
	S NEXP="",(N,AR)=0,ST=1
	S I=0 F  D  Q:'I!$G(DIERR)
	. S I=$$FIND^DDSLIB(EXP,"{",I) Q:'I
	. S N=N+1
	. S NEXP=NEXP_$E(EXP,ST,I-2)_"DDSE("_N_")"
	. S ST=$$FIND^DDSLIB(EXP,"}",I)
	. D EVAL(DDP,$E(EXP,I,ST-2),BK,N,.AR,.FDL) Q:$G(DIERR)
	. S I=ST
	Q:$G(DIERR)
	S NEXP=$S(EXP?1"=".E:"S Y",1:"")_NEXP_$E(EXP,ST,999)
	;
	S AR=N
	S:$G(FDL)]"" FDL=$E(FDL,1,$L(FDL)-1)
	Q
	;
EVAL(DDP,EXP,BK,N,AR,FDL)	;Evaluate field expression
	;In:
	;  EXP = computed expr
	;  N   = expr number -- index into DDSE()
	;Out:
	;  AR  = array of code that sets DDSE(n)
	;  FDL = list of fields used in expr
	;
	N CD
	D:EXP?1"FO(".E FO^DDSPTR(DDP,EXP,"","",BK,.CD,.FDL,1)
	D:EXP'?1"FO(".E DD^DDSPTR(DDP,EXP,"",.CD,.FDL,1)
	Q:$G(DIERR)
	;
	I CD=1 S AR(N)="N X "_CD(1)_",DDSE("_N_")=X"
	E  D
	. F CD=1:1:CD S AR(N,CD)=CD(CD)
	. S AR(N,CD)=AR(N,CD)_",DDSE("_N_")=X"
	. 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)"
	Q
	;
RPCF(DDSPG)	;Repaint computed fields
	;Called from ^DDS01 and ^DDSVALF when value used in
	;computed expression changes
	N DDSCBK,DDSCDDO
	;
	S DDSCBK="" F  S DDSCBK=$O(@DDSREFS@("COMP",DDP,DDSFLD,DDSPG,DDSCBK)) Q:DDSCBK=""  D
	. N DA
	. D GETDA(DDSPG,DDSCBK,.DA)
	. S DDSCDDO="" F  S DDSCDDO=$O(@DDSREFS@("COMP",DDP,DDSFLD,DDSPG,DDSCBK,DDSCDDO)) Q:DDSCDDO=""  D RPCF1
	;
	Q
	;
RPCF1	;
	N DDSC,DDSE,DDSLEN,DDSX
	S DDSC=$G(@DDSREFS@(DDSPG,DDSCBK,DDSCDDO,"D")) Q:DDSC=""
	S DDSX=$$VAL(DDSCDDO,DDSCBK)
	;
	S DY=+DDSC,DX=$P(DDSC,U,2),DDSLEN=$P(DDSC,U,3)
	I $P(DDSC,U,10) S DDSX=$J("",DDSLEN-$L(DDSX))_$E(DDSX,1,DDSLEN)
	E  S DDSX=$E(DDSX,1,DDSLEN)_$J("",DDSLEN-$L(DDSX))
	X IOXY
	W $P(DDGLVID,DDGLDEL)_DDSX_$P(DDGLVID,DDGLDEL,10)
	;
	N DDP,DDSFLD
	S DDP=0,DDSFLD=DDSCDDO_","_DDSBK
	D:$D(@DDSREFS@("COMP",DDP,DDSFLD,DDSPG)) RPCF(DDSPG)
	;
	Q
	;
GETDA(P,B,DA)	;Get DA array of block
	S DA=$G(@DDSREFT@(P,B)) Q:DA=""  Q:'$G(^(B,DA))
	F I=2:1:$L(DA,",")-1 S DA(I-1)=$P(DA,",",I)
	S DA=+DA
	Q
	;
VAL(DDSDDO,DDSBK,DDSDA)	;Return value of computed field
	N DDSE,DDSX,Y
	I $D(DDSDA) N DA D DA(DDSDA,.DA)
	S DDSX=0 F  S DDSX=$O(@DDSREFS@("COMPE",DDSBK,DDSDDO,DDSX)) Q:DDSX=""  X ^(DDSX)
	K Y X $G(@DDSREFS@("COMPE",DDSBK,DDSDDO))
	Q $G(Y)
	;
DA(DDSDA,DA)	;Return DA array based on DDSDA
	N I
	S DA=$P(DDSDA,",")
	F I=2:1:$L(DDSDA,",") S DA(I-1)=$P(DDSDA,",",I)
	Q