| [613] | 1 | DDSCOMP ;SFISC/MKO-EVALUATE COMPUTED EXPRESSIONS ;8:55 AM 12 Feb 1999
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 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 | . I $P($G(@DDSREFS@(DDSPG,DDSCBK)),U,7)>1 D DB^DDSR(DDSPG,DDSCBK) Q
|
|---|
| 54 | . N DA,DDSDA
|
|---|
| 55 | . D GETDA(DDSPG,DDSCBK,.DA)
|
|---|
| 56 | . S DDSDA=$$DDSDA(.DA)
|
|---|
| 57 | . S DDSCDDO="" F S DDSCDDO=$O(@DDSREFS@("COMP",DDP,DDSFLD,DDSPG,DDSCBK,DDSCDDO)) Q:DDSCDDO="" D RPCF1
|
|---|
| 58 | ;
|
|---|
| 59 | Q
|
|---|
| 60 | ;
|
|---|
| 61 | RPCF1 ;
|
|---|
| 62 | N DDSC,DDSE,DDSLEN,DDSX
|
|---|
| 63 | S DDSC=$G(@DDSREFS@(DDSPG,DDSCBK,DDSCDDO,"D")) Q:DDSC=""
|
|---|
| 64 | S DDSX=$$VAL(DDSCDDO,DDSCBK,DDSDA)
|
|---|
| 65 | ;
|
|---|
| 66 | S DY=+DDSC,DX=$P(DDSC,U,2),DDSLEN=$P(DDSC,U,3)
|
|---|
| 67 | I $P(DDSC,U,10) S DDSX=$J("",DDSLEN-$L(DDSX))_$E(DDSX,1,DDSLEN)
|
|---|
| 68 | E S DDSX=$E(DDSX,1,DDSLEN)_$J("",DDSLEN-$L(DDSX))
|
|---|
| 69 | X IOXY
|
|---|
| 70 | W $P(DDGLVID,DDGLDEL)_DDSX_$P(DDGLVID,DDGLDEL,10)
|
|---|
| 71 | ;
|
|---|
| 72 | N DDP,DDSFLD
|
|---|
| 73 | S DDP=0,DDSFLD=DDSCDDO_","_DDSBK
|
|---|
| 74 | D:$D(@DDSREFS@("COMP",DDP,DDSFLD,DDSPG)) RPCF(DDSPG)
|
|---|
| 75 | ;
|
|---|
| 76 | Q
|
|---|
| 77 | ;
|
|---|
| 78 | GETDA(P,B,DA) ;Get DA array of block
|
|---|
| 79 | N I K DA
|
|---|
| 80 | S DA=$G(@DDSREFT@(P,B)) Q:DA="" Q:'$G(^(B,DA))
|
|---|
| 81 | F I=2:1:$L(DA,",")-1 S DA(I-1)=$P(DA,",",I)
|
|---|
| 82 | S DA=+DA
|
|---|
| 83 | Q
|
|---|
| 84 | ;
|
|---|
| 85 | VAL(DDSDDO,DDSBK,DDSDA) ;Return value of computed field
|
|---|
| 86 | N DDSE,DDSX,Y
|
|---|
| 87 | I $D(DDSDA) N DA D DA(DDSDA,.DA)
|
|---|
| 88 | S DDSX=0 F S DDSX=$O(@DDSREFS@("COMPE",DDSBK,DDSDDO,DDSX)) Q:DDSX="" X ^(DDSX)
|
|---|
| 89 | K Y X $G(@DDSREFS@("COMPE",DDSBK,DDSDDO))
|
|---|
| 90 | Q $G(Y)
|
|---|
| 91 | ;
|
|---|
| 92 | DA(DDSDA,DA) ;Return DA array based on DDSDA
|
|---|
| 93 | N I
|
|---|
| 94 | S DA=$P(DDSDA,",")
|
|---|
| 95 | F I=2:1:$L(DDSDA,",") S DA(I-1)=$P(DDSDA,",",I)
|
|---|
| 96 | Q
|
|---|
| 97 | ;
|
|---|
| 98 | DDSDA(DA) ;Return DDSDA based on DA array
|
|---|
| 99 | N DDSDA,I
|
|---|
| 100 | I $G(DA)="" S DDSDA="0,"
|
|---|
| 101 | E D
|
|---|
| 102 | . S DDSDA=DA_","
|
|---|
| 103 | . F I=1:1 Q:$G(DA(I))="" S DDSDA=DDSDA_DA(I)_","
|
|---|
| 104 | Q DDSDA
|
|---|
