Return to DDSCOMP.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Annotation of freem_fileman/USER/DDSCOMP.m, revision 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