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