source: FOIAVistA/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DDSCOMP.m@ 1516

Last change on this file since 1516 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 2.9 KB
Line 
1DDSCOMP ;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 ;
5PARSE(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 ;
27EVAL(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 ;
47RPCF(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 ;
61RPCF1 ;
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 ;
78GETDA(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 ;
85VAL(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 ;
92DA(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 ;
98DDSDA(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
Note: See TracBrowser for help on using the repository browser.