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

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")
 ;