Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DDSCOMP

DDSCOMP.m

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