Return to DDSCOMP.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DDSCOMP.m, revision 1.1.1.1

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