OCXOCMPB ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Parse a Rule Relation Expression) ;10/29/98 12:37 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998 ; Q ; PARSE(OCXD0,OCXD1,OCXEXP,OCXCD) ; ; Q:$G(OCXWARN) 1 N OCXRES,OCXSTAK,OCXPTR,OCXTKN,OCXERR,OCXTEXP,OCXDASH N OCXBOOL,OCXPTKN,OCXX,OCXD2,OCXD3,OCXTPTR2 K ^TMP("OCXCMP",$J,"CODE") M ^TMP("OCXCMP",$J,"CODE")=OCXCD ; S:($P(OCXEXP," ",1)="IF") OCXEXP=$P(OCXEXP," ",2,999) S OCXEXP=$$PARCNT^OCXOCMPF(OCXEXP) Q:'$L(OCXEXP) OCXWARN Q:OCXWARN OCXWARN ; F OCXTPTR=1:1:($L(OCXEXP," ")+1) S OCXTXT=$P(OCXEXP," ",OCXTPTR) I $L(OCXTXT) D Q:OCXWARN .N OCXSTOP .; .; TOKENIZE TERM .; .S OCXPTKN=+$$TOP .S OCXTKN=$S($L($G(^TMP("OCXCMP",$J,"CODE","B",OCXTXT))):1,(OCXTXT="AND"):3,(OCXTXT="OR"):4,(OCXTXT="("):5,(OCXTXT=")"):6,1:0) .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 .I (OCXTKN=1) S:(OCXPTKN=3) OCXTKN=2 S:(OCXPTKN=4) OCXTKN=2 S OCXTXT=$G(^TMP("OCXCMP",$J,"CODE","B",OCXTXT)) .I +OCXTXT,+$G(OCXCD(+OCXTXT)) S ^TMP("OCXCMP",$J,"RULE",OCXD0,OCXD1,+OCXCD(+OCXTXT))=+OCXTXT .; .; CHECK FOR SYNTAX ERROR .; .I 'OCXTKN D SYNTXER^OCXOCMPF(OCXEXP,OCXTPTR,OCXTXT,OCXTKN) S OCXWARN=1 Q .I ("50"[+OCXPTKN),'("15"[(+OCXTKN)) D SYNTXER^OCXOCMPF(OCXEXP,OCXTPTR,OCXPTKN,OCXTKN) S OCXWARN=1 Q .I ("126"[+OCXPTKN),'("346"[(+OCXTKN)) D SYNTXER^OCXOCMPF(OCXEXP,OCXTPTR,OCXPTKN,OCXTKN) S OCXWARN=1 Q .I ("34"[+OCXPTKN),'("25"[(+OCXTKN)) D SYNTXER^OCXOCMPF(OCXEXP,OCXTPTR,OCXPTKN,OCXTKN) S OCXWARN=1 Q .; .Q:OCXWARN .; .; PUT TERM ON THE STACK .; .I (OCXTKN<3) D ..N OCXTMP M OCXTMP=^TMP("OCXCMP",$J,"CODE",+OCXTXT) D PUSH(OCXTKN_U_OCXTXT,.OCXTMP) .I (OCXTKN>2) D PUSH(OCXTKN_U_OCXTXT) .; .; PROCESS THE STACK .; .F D Q:OCXSTOP ..N OCXTOP S OCXSTOP=1,OCXTOP=+$$TOP ..; ..I (OCXTOP=1),(+$$TOP(1)=3) S OCXTOP=2 ..I (OCXTOP=1),(+$$TOP(1)=4) S OCXTOP=2 ..; ..I (OCXTOP=2) D S OCXSTOP=0 Q ; SECOND DATA FIELD ...N FLD1,OPER,FLD2,FLD3,NXTFLD ...D POP(.FLD2),POP(.OPER),POP(.FLD1) ...S NXTFLD=$O(^TMP("OCXCMP",$J,"CODE","B"),-1)+1,^TMP("OCXCMP",$J,"CODE",NXTFLD)="",FLD3="1^"_NXTFLD ...; ...I (+OPER=3) D ; AND OPERATOR ....N SUB1,SUB2,DOTS ....S SUB1=0 F S SUB1=$O(FLD1("CODE",SUB1)) Q:'SUB1 D .....N VAL1,VAL2 .....S (VAL1,VAL2)=FLD1("CODE",SUB1) S:(VAL1[" @@@@") VAL2=$P(VAL1," @@@@",1)_" "_$P(VAL1," @@@@",2) .....S FLD3("CODE",$O(FLD3("CODE","B"),-1)+1)=VAL2 .....Q:'(VAL1["@@@@") .....F DOTS=1:1:$L(VAL1) Q:'($E(VAL1,DOTS)=".") .....S SUB2=0 F S SUB2=$O(FLD2("CODE",SUB2)) Q:'SUB2 D ......S FLD3("CODE",$O(FLD3("CODE","B"),-1)+1)=$E("..................",1,DOTS)_FLD2("CODE",SUB2) ...; ...I (+OPER=4) D ; OR OPERATOR ....N SUB ....S SUB=0 F S SUB=$O(FLD1("CODE",SUB)) Q:'SUB S FLD3("CODE",$O(FLD3("CODE","B"),-1)+1)=FLD1("CODE",SUB) ....S SUB=0 F S SUB=$O(FLD2("CODE",SUB)) Q:'SUB S FLD3("CODE",$O(FLD3("CODE","B"),-1)+1)=FLD2("CODE",SUB) ...; ...S FLD3("LABEL")="("_FLD1("LABEL")_" "_$S((+OPER=3):"AND",1:"OR")_" "_FLD2("LABEL")_")" ...M ^TMP("OCXCMP",$J,"CODE",NXTFLD)=FLD3 ...D PUSH(FLD3,.FLD3) ..; ..I (+$$TOP(0)=6),(+$$TOP(1)=1),(+$$TOP(2)=5) S OCXSTOP=0 D ; RIGHT PARENTHESIS ...N FLD,TEMP D POP(.TEMP),POP(.FLD),POP(TEMP),PUSH(FLD,.FLD) ; K OCXTKN D POP(.OCXTKN) M ^TMP("OCXCMP",$J,"RULE",OCXD0,OCXD1)=OCXTKN I $D(OCXSTAK) D WARN^OCXOCMPV(" ERROR: Incomplete expression..",2,OCXD0,$P($T(+1)," ",1)) Q OCXWARN K ^TMP("OCXCMP",$J,"CODE") Q OCXWARN ; PUSH(V,C) ; N T S T=$O(OCXSTAK(99999),-1)+1 S OCXSTAK(T)=V I $D(C) M OCXSTAK(T,"CODE")=C("CODE"),OCXSTAK(T,"LABEL")=C("LABEL") Q ; POP(V) ; N L K V S V="",L=$O(OCXSTAK(99999),-1) Q:'L M V=OCXSTAK(L) K OCXSTAK(L) Q ; TOP(C) ; Q:'$D(OCXSTAK) "" Q:'$D(C) OCXSTAK($O(OCXSTAK(999999),-1)) N L,X S L=$O(OCXSTAK(99999),-1) Q:'L "" F X=1:1:C S L=$O(OCXSTAK(L),-1) Q:'L Q:'L "" Q OCXSTAK(L) K C ; TKTXT(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") ;