OCXOCMPC.m

OCXOCMPC ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Optimize a Boolean 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

 ;

OPTMIZ(OCXD0,OCXEXP) ;

 ;

 Q 0

 N OCXRES,OCXSTAK,OCXPTR,OCXFLST,OCXTKN,OCXERR,OCXTEXP,OCXDASH,OCXBOOL,OCXPTKN,OCXX

 ;

 S OCXEXP=$$PARCNT(OCXEXP) Q:'$L(OCXEXP) OCXWARN Q:OCXWARN OCXWARN

 ;

 S OCXEXP=$TR(OCXEXP,"~","")

 ;

 S OCXEXP=$$STRIP(OCXEXP)

 ;

 I 0 W ! S OCXOP="" F OCXPTR=1:1:$L(OCXEXP," ") D

 .F  Q:'(+$$TOP)  Q:'($$TOP=$$TOP(2))  S OCXX=$$POP,OCXX=$$POP D DISP

 .;

 .I (+$P(OCXEXP," ",OCXPTR)) D PUSH(+$P(OCXEXP," ",OCXPTR)) D DISP Q

 .;

 .I ($P(OCXEXP," ",OCXPTR)="(") D PUSH("(") S OCXOP="" D DISP Q

 .;

 .I ($P(OCXEXP," ",OCXPTR)=")") D  S OCXOP="" D DISP Q

 ..N SUB,POP S SUB="" F  S POP=$$POP Q:'$L(POP)  Q:(POP="(")  S:$L(SUB) SUB=" "_SUB S SUB=POP_SUB

 ..D PUSH($$TOKEN(SUB))

 .;

 .I '$L(OCXOP) S OCXOP=$P(OCXEXP," ",OCXPTR) D PUSH(OCXOP) D DISP Q

 .;

 .I '(OCXOP=$P(OCXEXP," ",OCXPTR)) D  D DISP Q

 ..N SUB,POP S SUB="" F  S POP=$$POP Q:'$L(POP)  Q:(POP="(")  S:$L(SUB) SUB=" "_SUB S SUB=POP_SUB

 ..D PUSH("(")

 ..D PUSH($$TOKEN(SUB))

 ..S OCXOP=$P(OCXEXP," ",OCXPTR)

 ..D PUSH(OCXOP)

 .;

 .D PUSH($P(OCXEXP," ",OCXPTR)) D DISP Q

 ;

 S OCXEXP=$$EXPAND(OCXEXP)

 ;

 Q 0_U_$TR(OCXEXP," ","")

 ;

DISP ;

 Q:$G(OCXAUTO)

 W !,$P(OCXEXP," ",1,OCXPTR),!

 Q

TOKEN(VAL) ;

 ;

 Q:($L(VAL," ")=1) VAL

 N ORD,OPER,PTR

 S OPER=$P(VAL," ",2)

 F PTR=1:2:$L(VAL," ") S ORD($P(VAL," ",PTR))=""

 S VAL="",PTR=0 F  S PTR=$O(ORD(PTR)) Q:'PTR  S:$L(VAL) VAL=VAL_" "_OPER_" " S VAL=VAL_PTR

 ;

 S PTR=+$G(^TMP("OCXCMP",$J,"B TOKEN","B",VAL)) Q:PTR PTR

 ;

 F PTR=$O(^OCXS(860.3,999999),-1)+1:1 Q:'$D(^TMP("OCXCMP",$J,"B TOKEN",+PTR))

 S ^TMP("OCXCMP",$J,"B TOKEN",+PTR)=VAL

 S ^TMP("OCXCMP",$J,"B TOKEN","B",VAL)=+PTR

 Q +PTR

 ;

PUSH(V) S OCXSTAK($O(OCXSTAK(99999),-1)+1)=V Q

 ;

POP() N L,V S L=$O(OCXSTAK(99999),-1) Q:'L "" S V=OCXSTAK(L) K OCXSTAK(L) Q V

 ;

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

 ;

STRIP(EXP) ;

 ;

 N QUIT,PTR

 F  S QUIT=1 D  Q:QUIT

 .F PTR=1:1:($L(EXP," ")-2) I ($P(EXP," ",PTR)="("),(+$P(EXP," ",PTR+1)),($P(EXP," ",PTR+2)=")") S QUIT=0 D  Q

 ..I (PTR>1) S EXP=$P(EXP," ",1,PTR-1)_" "_(+$P(EXP," ",PTR+1))_" "_$P(EXP," ",PTR+3,99999) Q

 ..S EXP=(+$P(EXP," ",PTR+1))_" "_$P(EXP," ",PTR+3,99999)

 Q EXP

 ;

PARCNT(EXP) ;

 N CNT,PTR,TEMP

 S CNT=0,TEMP="" F PTR=1:1:$L(EXP) D

 .N CHAR S CHAR=$E(EXP,PTR)

 .I (CHAR="(") S CNT=CNT+1,TEMP=TEMP_" ( "

 .E  I (CHAR=")") S CNT=CNT-1,TEMP=TEMP_" ) "

 .E  I '(CHAR=" "),'(CHAR="~"),(CHAR?1P) S TEMP=TEMP_" "_CHAR_" "

 .E  S TEMP=TEMP_CHAR

 I CNT D  Q ""

 .N MSG

 .S MSG(1)=" "_EXP,MSG(2)=" "

 .I (CNT>0) S MSG(3)=" "_(CNT)_" Unmatched LEFT '(' parenthesis in expression"

 .I (CNT<0) S MSG(3)=" "_(CNT*(-1))_" Unmatched RIGHT ')' parenthesis in expression"

 .D WARN^OCXOCMPV(.MSG,2,OCXD0,$P($T(+1)," ",1)) Q

 ;

 F  Q:'(TEMP["  ")  S TEMP=$P(TEMP,"  ",1)_" "_$P(TEMP,"  ",2,999)

 F  Q:'($E(TEMP,1)=" ")  S TEMP=$E(TEMP,2,$L(TEMP))

 Q TEMP

 ;

EXPAND(EXP) ;

 ;

 N QUIT,PTR

 F PTR=1:1:$L(EXP," ") S:+$P(EXP," ",PTR) $P(EXP," ",PTR)="~"_$P(EXP," ",PTR)_"~"

 F  Q:'(EXP["~")  S EXP=$P(EXP,"~",1)_$G(^TMP("OCXCMP",$J,"B TOKEN",+$P(EXP,"~",2)))_$P(EXP,"~",3,999)

 Q EXP

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---OCXOCMPC   3478     printed  Apr 23, 2025@18:39:23                                                                                                                                                                                                    Page 2

OCXOCMPC  ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Optimize a Boolean Expression) ;10/29/98  12:37

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997

 +2       ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998

 +3       ;

 +4        QUIT 

 +5       ;

OPTMIZ(OCXD0,OCXEXP) ;

 +1       ;

 +2        QUIT 0

 +3        NEW OCXRES,OCXSTAK,OCXPTR,OCXFLST,OCXTKN,OCXERR,OCXTEXP,OCXDASH,OCXBOOL,OCXPTKN,OCXX

 +4       ;

 +5        SET OCXEXP=$$PARCNT(OCXEXP)

           if '$LENGTH(OCXEXP)

               QUIT OCXWARN

           if OCXWARN

               QUIT OCXWARN

 +6       ;

 +7        SET OCXEXP=$TRANSLATE(OCXEXP,"~","")

 +8       ;

 +9        SET OCXEXP=$$STRIP(OCXEXP)

 +10      ;

 +11       IF 0

               WRITE !

               SET OCXOP=""

               FOR OCXPTR=1:1:$LENGTH(OCXEXP," ")

                   Begin DoDot:1

 +12                   FOR 

                           if '(+$$TOP)

                               QUIT 

                           if '($$TOP=$$TOP(2))

                               QUIT 

                           SET OCXX=$$POP

                           SET OCXX=$$POP

                           DO DISP

 +13      ;

 +14                   IF (+$PIECE(OCXEXP," ",OCXPTR))

                           DO PUSH(+$PIECE(OCXEXP," ",OCXPTR))

                           DO DISP

                           QUIT 

 +15      ;

 +16                   IF ($PIECE(OCXEXP," ",OCXPTR)="(")

                           DO PUSH("(")

                           SET OCXOP=""

                           DO DISP

                           QUIT 

 +17      ;

 +18                   IF ($PIECE(OCXEXP," ",OCXPTR)=")")

                           Begin DoDot:2

 +19                           NEW SUB,POP

                               SET SUB=""

                               FOR 

                                   SET POP=$$POP

                                   if '$LENGTH(POP)

                                       QUIT 

                                   if (POP="(")

                                       QUIT 

                                   if $LENGTH(SUB)

                                       SET SUB=" "_SUB

                                   SET SUB=POP_SUB

 +20                           DO PUSH($$TOKEN(SUB))

                           End DoDot:2

                           SET OCXOP=""

                           DO DISP

                           QUIT 

 +21      ;

 +22                   IF '$LENGTH(OCXOP)

                           SET OCXOP=$PIECE(OCXEXP," ",OCXPTR)

                           DO PUSH(OCXOP)

                           DO DISP

                           QUIT 

 +23      ;

 +24                   IF '(OCXOP=$PIECE(OCXEXP," ",OCXPTR))

                           Begin DoDot:2

 +25                           NEW SUB,POP

                               SET SUB=""

                               FOR 

                                   SET POP=$$POP

                                   if '$LENGTH(POP)

                                       QUIT 

                                   if (POP="(")

                                       QUIT 

                                   if $LENGTH(SUB)

                                       SET SUB=" "_SUB

                                   SET SUB=POP_SUB

 +26                           DO PUSH("(")

 +27                           DO PUSH($$TOKEN(SUB))

 +28                           SET OCXOP=$PIECE(OCXEXP," ",OCXPTR)

 +29                           DO PUSH(OCXOP)

                           End DoDot:2

                           DO DISP

                           QUIT 

 +30      ;

 +31                   DO PUSH($PIECE(OCXEXP," ",OCXPTR))

                       DO DISP

                       QUIT 

                   End DoDot:1

 +32      ;

 +33       SET OCXEXP=$$EXPAND(OCXEXP)

 +34      ;

 +35       QUIT 0_U_$TRANSLATE(OCXEXP," ","")

 +36      ;

DISP      ;

 +1        if $GET(OCXAUTO)

               QUIT 

 +2        WRITE !,$PIECE(OCXEXP," ",1,OCXPTR),!

 +3        QUIT 

TOKEN(VAL) ;

 +1       ;

 +2        if ($LENGTH(VAL," ")=1)

               QUIT VAL

 +3        NEW ORD,OPER,PTR

 +4        SET OPER=$PIECE(VAL," ",2)

 +5        FOR PTR=1:2:$LENGTH(VAL," ")

               SET ORD($PIECE(VAL," ",PTR))=""

 +6        SET VAL=""

           SET PTR=0

           FOR 

               SET PTR=$ORDER(ORD(PTR))

               if 'PTR

                   QUIT 

               if $LENGTH(VAL)

                   SET VAL=VAL_" "_OPER_" "

               SET VAL=VAL_PTR

 +7       ;

 +8        SET PTR=+$GET(^TMP("OCXCMP",$JOB,"B TOKEN","B",VAL))

           if PTR

               QUIT PTR

 +9       ;

 +10       FOR PTR=$ORDER(^OCXS(860.3,999999),-1)+1:1

               if '$DATA(^TMP("OCXCMP",$JOB,"B TOKEN",+PTR))

                   QUIT 

 +11       SET ^TMP("OCXCMP",$JOB,"B TOKEN",+PTR)=VAL

 +12       SET ^TMP("OCXCMP",$JOB,"B TOKEN","B",VAL)=+PTR

 +13       QUIT +PTR

 +14      ;

PUSH(V)    SET OCXSTAK($ORDER(OCXSTAK(99999),-1)+1)=V

           QUIT 

 +1       ;

POP()      NEW L,V

           SET L=$ORDER(OCXSTAK(99999),-1)

           if 'L

               QUIT ""

           SET V=OCXSTAK(L)

           KILL OCXSTAK(L)

           QUIT V

 +1       ;

TOP(C)    ;

 +1        if '$DATA(OCXSTAK)

               QUIT ""

           if '$DATA(C)

               QUIT OCXSTAK($ORDER(OCXSTAK(999999),-1))

 +2        NEW L,X

           SET L=$ORDER(OCXSTAK(99999),-1)

           if 'L

               QUIT ""

           FOR X=1:1:C

               SET L=$ORDER(OCXSTAK(L),-1)

               if 'L

                   QUIT 

 +3        if 'L

               QUIT ""

           QUIT OCXSTAK(L)

 +4        KILL C

 +5       ;

STRIP(EXP) ;

 +1       ;

 +2        NEW QUIT,PTR

 +3        FOR 

               SET QUIT=1

               Begin DoDot:1

 +4                FOR PTR=1:1:($LENGTH(EXP," ")-2)

                       IF ($PIECE(EXP," ",PTR)="(")

                           IF (+$PIECE(EXP," ",PTR+1))

                               IF ($PIECE(EXP," ",PTR+2)=")")

                                   SET QUIT=0

                                   Begin DoDot:2

 +5                                    IF (PTR>1)

                                           SET EXP=$PIECE(EXP," ",1,PTR-1)_" "_(+$PIECE(EXP," ",PTR+1))_" "_$PIECE(EXP," ",PTR+3,99999)

                                           QUIT 

 +6                                    SET EXP=(+$PIECE(EXP," ",PTR+1))_" "_$PIECE(EXP," ",PTR+3,99999)

                                   End DoDot:2

                                   QUIT 

               End DoDot:1

               if QUIT

                   QUIT 

 +7        QUIT EXP

 +8       ;

PARCNT(EXP) ;

 +1        NEW CNT,PTR,TEMP

 +2        SET CNT=0

           SET TEMP=""

           FOR PTR=1:1:$LENGTH(EXP)

               Begin DoDot:1

 +3                NEW CHAR

                   SET CHAR=$EXTRACT(EXP,PTR)

 +4                IF (CHAR="(")

                       SET CNT=CNT+1

                       SET TEMP=TEMP_" ( "

 +5               IF '$TEST

                       IF (CHAR=")")

                           SET CNT=CNT-1

                           SET TEMP=TEMP_" ) "

 +6               IF '$TEST

                       IF '(CHAR=" ")

                           IF '(CHAR="~")

                               IF (CHAR?1P)

                                   SET TEMP=TEMP_" "_CHAR_" "

 +7               IF '$TEST

                       SET TEMP=TEMP_CHAR

               End DoDot:1

 +8        IF CNT

               Begin DoDot:1

 +9                NEW MSG

 +10               SET MSG(1)=" "_EXP

                   SET MSG(2)=" "

 +11               IF (CNT>0)

                       SET MSG(3)=" "_(CNT)_" Unmatched LEFT '(' parenthesis in expression"

 +12               IF (CNT<0)

                       SET MSG(3)=" "_(CNT*(-1))_" Unmatched RIGHT ')' parenthesis in expression"

 +13               DO WARN^OCXOCMPV(.MSG,2,OCXD0,$PIECE($TEXT(+1)," ",1))

                   QUIT 

               End DoDot:1

               QUIT ""

 +14      ;

 +15       FOR 

               if '(TEMP["  ")

                   QUIT 

               SET TEMP=$PIECE(TEMP,"  ",1)_" "_$PIECE(TEMP,"  ",2,999)

 +16       FOR 

               if '($EXTRACT(TEMP,1)=" ")

                   QUIT 

               SET TEMP=$EXTRACT(TEMP,2,$LENGTH(TEMP))

 +17       QUIT TEMP

 +18      ;

EXPAND(EXP) ;

 +1       ;

 +2        NEW QUIT,PTR

 +3        FOR PTR=1:1:$LENGTH(EXP," ")

               if +$PIECE(EXP," ",PTR)

                   SET $PIECE(EXP," ",PTR)="~"_$PIECE(EXP," ",PTR)_"~"

 +4        FOR 

               if '(EXP["~")

                   QUIT 

               SET EXP=$PIECE(EXP,"~",1)_$GET(^TMP("OCXCMP",$JOB,"B TOKEN",+$PIECE(EXP,"~",2)))_$PIECE(EXP,"~",3,999)

 +5        QUIT EXP

 +6       ;