source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXOCMPB.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 4.1 KB
Line 
1OCXOCMPB ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Parse a Rule Relation Expression) ;10/29/98 12:37
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
3 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
4 ;
5 Q
6 ;
7PARSE(OCXD0,OCXD1,OCXEXP,OCXCD) ;
8 ;
9 Q:$G(OCXWARN) 1
10 N OCXRES,OCXSTAK,OCXPTR,OCXTKN,OCXERR,OCXTEXP,OCXDASH
11 N OCXBOOL,OCXPTKN,OCXX,OCXD2,OCXD3,OCXTPTR2
12 K ^TMP("OCXCMP",$J,"CODE")
13 M ^TMP("OCXCMP",$J,"CODE")=OCXCD
14 ;
15 S:($P(OCXEXP," ",1)="IF") OCXEXP=$P(OCXEXP," ",2,999)
16 S OCXEXP=$$PARCNT^OCXOCMPF(OCXEXP) Q:'$L(OCXEXP) OCXWARN Q:OCXWARN OCXWARN
17 ;
18 F OCXTPTR=1:1:($L(OCXEXP," ")+1) S OCXTXT=$P(OCXEXP," ",OCXTPTR) I $L(OCXTXT) D Q:OCXWARN
19 .N OCXSTOP
20 .;
21 .; TOKENIZE TERM
22 .;
23 .S OCXPTKN=+$$TOP
24 .S OCXTKN=$S($L($G(^TMP("OCXCMP",$J,"CODE","B",OCXTXT))):1,(OCXTXT="AND"):3,(OCXTXT="OR"):4,(OCXTXT="("):5,(OCXTXT=")"):6,1:0)
25 .I 'OCXTKN F OCXTPTR2=OCXTPTR:1:($L(OCXEXP," ")+1) I $L($G(^TMP("OCXCMP",$J,"CODE","B",$P(OCXEXP," ",OCXTPTR,OCXTPTR2)))) S OCXTKN=1,OCXTXT=$P(OCXEXP," ",OCXTPTR,OCXTPTR2),OCXTPTR=OCXTPTR2 Q
26 .I (OCXTKN=1) S:(OCXPTKN=3) OCXTKN=2 S:(OCXPTKN=4) OCXTKN=2 S OCXTXT=$G(^TMP("OCXCMP",$J,"CODE","B",OCXTXT))
27 .I +OCXTXT,+$G(OCXCD(+OCXTXT)) S ^TMP("OCXCMP",$J,"RULE",OCXD0,OCXD1,+OCXCD(+OCXTXT))=+OCXTXT
28 .;
29 .; CHECK FOR SYNTAX ERROR
30 .;
31 .I 'OCXTKN D SYNTXER^OCXOCMPF(OCXEXP,OCXTPTR,OCXTXT,OCXTKN) S OCXWARN=1 Q
32 .I ("50"[+OCXPTKN),'("15"[(+OCXTKN)) D SYNTXER^OCXOCMPF(OCXEXP,OCXTPTR,OCXPTKN,OCXTKN) S OCXWARN=1 Q
33 .I ("126"[+OCXPTKN),'("346"[(+OCXTKN)) D SYNTXER^OCXOCMPF(OCXEXP,OCXTPTR,OCXPTKN,OCXTKN) S OCXWARN=1 Q
34 .I ("34"[+OCXPTKN),'("25"[(+OCXTKN)) D SYNTXER^OCXOCMPF(OCXEXP,OCXTPTR,OCXPTKN,OCXTKN) S OCXWARN=1 Q
35 .;
36 .Q:OCXWARN
37 .;
38 .; PUT TERM ON THE STACK
39 .;
40 .I (OCXTKN<3) D
41 ..N OCXTMP M OCXTMP=^TMP("OCXCMP",$J,"CODE",+OCXTXT) D PUSH(OCXTKN_U_OCXTXT,.OCXTMP)
42 .I (OCXTKN>2) D PUSH(OCXTKN_U_OCXTXT)
43 .;
44 .; PROCESS THE STACK
45 .;
46 .F D Q:OCXSTOP
47 ..N OCXTOP S OCXSTOP=1,OCXTOP=+$$TOP
48 ..;
49 ..I (OCXTOP=1),(+$$TOP(1)=3) S OCXTOP=2
50 ..I (OCXTOP=1),(+$$TOP(1)=4) S OCXTOP=2
51 ..;
52 ..I (OCXTOP=2) D S OCXSTOP=0 Q ; SECOND DATA FIELD
53 ...N FLD1,OPER,FLD2,FLD3,NXTFLD
54 ...D POP(.FLD2),POP(.OPER),POP(.FLD1)
55 ...S NXTFLD=$O(^TMP("OCXCMP",$J,"CODE","B"),-1)+1,^TMP("OCXCMP",$J,"CODE",NXTFLD)="",FLD3="1^"_NXTFLD
56 ...;
57 ...I (+OPER=3) D ; AND OPERATOR
58 ....N SUB1,SUB2,DOTS
59 ....S SUB1=0 F S SUB1=$O(FLD1("CODE",SUB1)) Q:'SUB1 D
60 .....N VAL1,VAL2
61 .....S (VAL1,VAL2)=FLD1("CODE",SUB1) S:(VAL1[" @@@@") VAL2=$P(VAL1," @@@@",1)_" "_$P(VAL1," @@@@",2)
62 .....S FLD3("CODE",$O(FLD3("CODE","B"),-1)+1)=VAL2
63 .....Q:'(VAL1["@@@@")
64 .....F DOTS=1:1:$L(VAL1) Q:'($E(VAL1,DOTS)=".")
65 .....S SUB2=0 F S SUB2=$O(FLD2("CODE",SUB2)) Q:'SUB2 D
66 ......S FLD3("CODE",$O(FLD3("CODE","B"),-1)+1)=$E("..................",1,DOTS)_FLD2("CODE",SUB2)
67 ...;
68 ...I (+OPER=4) D ; OR OPERATOR
69 ....N SUB
70 ....S SUB=0 F S SUB=$O(FLD1("CODE",SUB)) Q:'SUB S FLD3("CODE",$O(FLD3("CODE","B"),-1)+1)=FLD1("CODE",SUB)
71 ....S SUB=0 F S SUB=$O(FLD2("CODE",SUB)) Q:'SUB S FLD3("CODE",$O(FLD3("CODE","B"),-1)+1)=FLD2("CODE",SUB)
72 ...;
73 ...S FLD3("LABEL")="("_FLD1("LABEL")_" "_$S((+OPER=3):"AND",1:"OR")_" "_FLD2("LABEL")_")"
74 ...M ^TMP("OCXCMP",$J,"CODE",NXTFLD)=FLD3
75 ...D PUSH(FLD3,.FLD3)
76 ..;
77 ..I (+$$TOP(0)=6),(+$$TOP(1)=1),(+$$TOP(2)=5) S OCXSTOP=0 D ; RIGHT PARENTHESIS
78 ...N FLD,TEMP D POP(.TEMP),POP(.FLD),POP(TEMP),PUSH(FLD,.FLD)
79 ;
80 K OCXTKN D POP(.OCXTKN)
81 M ^TMP("OCXCMP",$J,"RULE",OCXD0,OCXD1)=OCXTKN
82 I $D(OCXSTAK) D WARN^OCXOCMPV(" ERROR: Incomplete expression..",2,OCXD0,$P($T(+1)," ",1)) Q OCXWARN
83 K ^TMP("OCXCMP",$J,"CODE")
84 Q OCXWARN
85 ;
86PUSH(V,C) ;
87 N T
88 S T=$O(OCXSTAK(99999),-1)+1
89 S OCXSTAK(T)=V
90 I $D(C) M OCXSTAK(T,"CODE")=C("CODE"),OCXSTAK(T,"LABEL")=C("LABEL")
91 Q
92 ;
93POP(V) ;
94 N L K V S V="",L=$O(OCXSTAK(99999),-1) Q:'L M V=OCXSTAK(L) K OCXSTAK(L) Q
95 ;
96TOP(C) ;
97 Q:'$D(OCXSTAK) "" Q:'$D(C) OCXSTAK($O(OCXSTAK(999999),-1))
98 N L,X S L=$O(OCXSTAK(99999),-1) Q:'L "" F X=1:1:C S L=$O(OCXSTAK(L),-1) Q:'L
99 Q:'L "" Q OCXSTAK(L)
100 K C
101 ;
102TKTXT(T) Q $S(T=1:"Data Field 1",T=2:"Data Field 2",T=3:"AND Operator",T=4:"OR Operator",T=5:"Left Parenthesis",T=6:"Right Parenthesis",1:"Token not found")
103 ;
Note: See TracBrowser for help on using the repository browser.