Routine: OCXOEDT

OCXOEDT ;SLC/RJS,CLA -  Rule Editor (Main Routine) ;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

S ;

 N OCXY,OCXTHLN,OCXTNLN,OCXTRLN,OCXTULN

 I '$D(IOF) S IOP="HOME" D ^%ZIS K IOP

 D RM(0),EN^OCXOED15

DIC(OCXDIC,OCXDIC0,OCXDICA,OCXX,OCXDICS,OCXDR) ;

 N DIC,X,Y

 S DIC=$G(OCXDIC) Q:'$L(DIC) -1

 S DIC(0)=$G(OCXDIC0) S:$L($G(OCXX)) X=OCXX

 S:$L($G(OCXDICS)) DIC("S")=OCXDICS

 S:$L($G(OCXDICA)) DIC("A")=OCXDICA

 S:$L($G(OCXDR)) DIC("DR")=OCXDR

 D ^DIC Q:(Y<1) 0 Q Y

CONV ;

 S OCXR0=0 F  S OCXR0=$O(^OCXS(860.2,OCXR0)) Q:'OCXR0  D

 .W !,$P(^OCXS(860.2,OCXR0,0),U,1)

 .S OCXVAL=$G(^OCXS(860.2,OCXR0,"C",0))

 .I $L(OCXVAL),(OCXVAL["P") W !,?5,OCXVAL S OCXVAL=$P(OCXVAL,"P",1)_$P(OCXVAL,"P",2) W "  ",OCXVAL S ^OCXS(860.2,OCXR0,"C",0)=OCXVAL

 .S OCXVAL=$G(^OCXS(860.2,OCXR0,"R",0))

 .I $L(OCXVAL),(OCXVAL["P") W !,?5,OCXVAL S OCXVAL=$P(OCXVAL,"P",1)_$P(OCXVAL,"P",2) W "  ",OCXVAL S ^OCXS(860.2,OCXR0,"R",0)=OCXVAL

 .;S OCXD1=0 F  S OCXD1=$O(^OCXS(860.2,OCXR0,"C",OCXD1)) Q:'OCXD1  D

 .;.S OCXVAL=^OCXS(860.2,OCXR0,"C",OCXD1,0)

 .;.W !,?10,$P(^OCXS(860.3,+$P(OCXVAL,U,2),0),U,1),"  ",OCXVAL S $P(OCXVAL,U,3)=0 W "  ",OCXVAL

 .;.S ^OCXS(860.2,OCXR0,"C",OCXD1,0)=OCXVAL

RM(X) X ^%ZOSF("RM") Q

OPT(OCXSUB,OCXLN,OCXRTN,OCXACT,OCXPAR,OCXSYN) ;

 N OCXSUBC

 Q:$D(OCXACT(OCXSUB)) ""

 S OCXSUBC=$TR(OCXSUB,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")

 S OCXACT("B",OCXSUB)=""

 S OCXACT(OCXSUBC)="D "_OCXLN_"^OCXOED"_OCXRTN_$S($L($G(OCXPAR)):"("_$G(OCXPAR)_")",1:"")

 I $L($G(OCXSYN)) D  Q OCXTHLN_OCXTRLN_" "_OCXSYN_" "_OCXSUB_" "_OCXTNLN

 .S OCXSUBC=$TR(OCXSYN,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")

 .S OCXACT(OCXSUBC)="D "_OCXLN_"^OCXOED"_OCXRTN_$S($L($G(OCXPAR)):"("_$G(OCXPAR)_")",1:"")

 .S OCXACT("B",OCXSUBC)=""

 Q OCXTHLN_OCXTRLN_" "_OCXSUB_" "_OCXTNLN

GETOPT(OCXACT) ;

 N OCXOPT,OCXTHLN,OCXTNLN,OCXTRLN,OCXTULN

 S OCXTNLN=$C(27,91,48,109),OCXTRLN=$C(27,91,55,109),OCXTULN=$C(27,91,52,109),OCXTHLN=$C(27,91,49,109)

 W !!,OCXTHLN,"Option List -> "

 S OCXOPT="" F  S OCXOPT=$O(OCXACT("B",OCXOPT)) Q:'$L(OCXOPT)  D

 .W:($X>70) !,"                 " W OCXOPT W:$L($O(OCXACT("B",OCXOPT))) ", "

 W !!,OCXTNLN,"Choose an Option: " R OCXOPT:DTIME E  Q U

 Q:'$L(OCXOPT) U

 Q:(OCXOPT[U) U

 S OCXOPT=$TR(OCXOPT,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")

 Q:$D(OCXACT(OCXOPT)) OCXACT(OCXOPT)

 I '($E($O(OCXACT(OCXOPT)),1,$L(OCXOPT))=OCXOPT) W !!,"Selection not in list... " H 2 Q ""

 I ($E($O(OCXACT($O(OCXACT(OCXOPT)))),1,$L(OCXOPT))=OCXOPT) W !!,"Selection is ambiguous and matches more than one option... " H 2 Q ""

 Q OCXACT($O(OCXACT(OCXOPT)))

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOCXOEDT   2827     printed  Apr 23, 2025@18:40:05                                                                                                                                                                                                     Page 2

OCXOEDT   ;SLC/RJS,CLA -  Rule Editor (Main Routine) ;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       ;

S         ;

 +1       ;

 +2        NEW OCXY,OCXTHLN,OCXTNLN,OCXTRLN,OCXTULN

 +3       ;

 +4       ;

 +5        IF '$DATA(IOF)

               SET IOP="HOME"

               DO ^%ZIS

               KILL IOP

 +6        DO RM(0)

           DO EN^OCXOED15

 +7       ;

 +8        QUIT

 +9       ;

DIC(OCXDIC,OCXDIC0,OCXDICA,OCXX,OCXDICS,OCXDR) ;

 +1       ;

 +2        NEW DIC,X,Y

 +3        SET DIC=$GET(OCXDIC)

           if '$LENGTH(DIC)

               QUIT -1

 +4        SET DIC(0)=$GET(OCXDIC0)

           if $LENGTH($GET(OCXX))

               SET X=OCXX

 +5        if $LENGTH($GET(OCXDICS))

               SET DIC("S")=OCXDICS

 +6        if $LENGTH($GET(OCXDICA))

               SET DIC("A")=OCXDICA

 +7        if $LENGTH($GET(OCXDR))

               SET DIC("DR")=OCXDR

 +8        DO ^DIC

           if (Y<1)

               QUIT 0

           QUIT Y

 +9       ;

CONV      ;

 +1       ;

 +2        SET OCXR0=0

FOR

               SET OCXR0=$ORDER(^OCXS(860.2,OCXR0))

               if 'OCXR0

                   QUIT

               Begin DoDot:1

 +3                WRITE !,$PIECE(^OCXS(860.2,OCXR0,0),U,1)

 +4                SET OCXVAL=$GET(^OCXS(860.2,OCXR0,"C",0))

 +5                IF $LENGTH(OCXVAL)

                       IF (OCXVAL["P")

                           WRITE !,?5,OCXVAL

                           SET OCXVAL=$PIECE(OCXVAL,"P",1)_$PIECE(OCXVAL,"P",2)

                           WRITE "  ",OCXVAL

                           SET ^OCXS(860.2,OCXR0,"C",0)=OCXVAL

 +6                SET OCXVAL=$GET(^OCXS(860.2,OCXR0,"R",0))

 +7                IF $LENGTH(OCXVAL)

                       IF (OCXVAL["P")

                           WRITE !,?5,OCXVAL

                           SET OCXVAL=$PIECE(OCXVAL,"P",1)_$PIECE(OCXVAL,"P",2)

                           WRITE "  ",OCXVAL

                           SET ^OCXS(860.2,OCXR0,"R",0)=OCXVAL

 +8       ;S OCXD1=0 F  S OCXD1=$O(^OCXS(860.2,OCXR0,"C",OCXD1)) Q:'OCXD1  D

 +9       ;.S OCXVAL=^OCXS(860.2,OCXR0,"C",OCXD1,0)

 +10      ;.W !,?10,$P(^OCXS(860.3,+$P(OCXVAL,U,2),0),U,1),"  ",OCXVAL S $P(OCXVAL,U,3)=0 W "  ",OCXVAL

 +11      ;.S ^OCXS(860.2,OCXR0,"C",OCXD1,0)=OCXVAL

               End DoDot:1

 +12      ;

 +13       QUIT

 +14      ;

RM(X)      XECUTE ^%ZOSF("RM")

           QUIT

 +1       ;

OPT(OCXSUB,OCXLN,OCXRTN,OCXACT,OCXPAR,OCXSYN) ;

 +1       ;

 +2        NEW OCXSUBC

 +3        if $DATA(OCXACT(OCXSUB))

               QUIT ""

 +4        SET OCXSUBC=$TRANSLATE(OCXSUB,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")

 +5        SET OCXACT("B",OCXSUB)=""

 +6        SET OCXACT(OCXSUBC)="D "_OCXLN_"^OCXOED"_OCXRTN_$SELECT($LENGTH($GET(OCXPAR)):"("_$GET(OCXPAR)_")",1:"")

 +7        IF $LENGTH($GET(OCXSYN))

               Begin DoDot:1

 +8                SET OCXSUBC=$TRANSLATE(OCXSYN,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")

 +9                SET OCXACT(OCXSUBC)="D "_OCXLN_"^OCXOED"_OCXRTN_$SELECT($LENGTH($GET(OCXPAR)):"("_$GET(OCXPAR)_")",1:"")

 +10               SET OCXACT("B",OCXSUBC)=""

               End DoDot:1

               QUIT OCXTHLN_OCXTRLN_" "_OCXSYN_" "_OCXSUB_" "_OCXTNLN

 +11       QUIT OCXTHLN_OCXTRLN_" "_OCXSUB_" "_OCXTNLN

 +12      ;

GETOPT(OCXACT) ;

 +1       ;

 +2        NEW OCXOPT,OCXTHLN,OCXTNLN,OCXTRLN,OCXTULN

 +3       ;

 +4        SET OCXTNLN=$CHAR(27,91,48,109)

           SET OCXTRLN=$CHAR(27,91,55,109)

           SET OCXTULN=$CHAR(27,91,52,109)

           SET OCXTHLN=$CHAR(27,91,49,109)

 +5       ;

 +6        WRITE !!,OCXTHLN,"Option List -> "

 +7       ;

 +8        SET OCXOPT=""

FOR

               SET OCXOPT=$ORDER(OCXACT("B",OCXOPT))

               if '$LENGTH(OCXOPT)

                   QUIT

               Begin DoDot:1

 +9                if ($X>70)

                       WRITE !,"                 "

                   WRITE OCXOPT

                   if $LENGTH($ORDER(OCXACT("B",OCXOPT)))

                       WRITE ", "

               End DoDot:1

 +10      ;

 +11       WRITE !!,OCXTNLN,"Choose an Option: "

           READ OCXOPT:DTIME

          IF '$TEST

               QUIT U

 +12       if '$LENGTH(OCXOPT)

               QUIT U

 +13       if (OCXOPT[U)

               QUIT U

 +14      ;

 +15       SET OCXOPT=$TRANSLATE(OCXOPT,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")

 +16      ;

 +17       if $DATA(OCXACT(OCXOPT))

               QUIT OCXACT(OCXOPT)

 +18      ;

 +19       IF '($EXTRACT($ORDER(OCXACT(OCXOPT)),1,$LENGTH(OCXOPT))=OCXOPT)

               WRITE !!,"Selection not in list... "

               HANG 2

               QUIT ""

 +20       IF ($EXTRACT($ORDER(OCXACT($ORDER(OCXACT(OCXOPT)))),1,$LENGTH(OCXOPT))=OCXOPT)

               WRITE !!,"Selection is ambiguous and matches more than one option... "

               HANG 2

               QUIT ""

 +21      ;

 +22       QUIT OCXACT($ORDER(OCXACT(OCXOPT)))

 +23      ;

OCXOEDT.m