OCXODSP ;SLC/RJS,CLA - Rule Display (Expert System Display Main Screen) ;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 ;
;
;
EN ;
;
N OCXACT,OCXOPT,IOP,OCXOFF
;
I '$D(IOM) S IOP="HOME" D ^%ZIS K IOP
S OCXOFF=5
;
F K OCXACT S OCXACT="" D DISP(.OCXACT) S OCXOPT=$$GETOPT(.OCXACT) Q:(OCXOPT=U) X:$L(OCXOPT) OCXOPT
;
Q
;
DISP(OCXACT) ;
;
N OCXTHLN,OCXTNLN,OCXTRLN,OCXTULN,OCXTNLN
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 @IOF,OCXTNLN
W !,$$CENTER($$FIELD("Expert System Display"),80),!
I $L($T(VERSION^OCXOCMP)) W !,$$CENTER($$FIELD($$VERSION^OCXOCMP),80),!
W !
W !," ",$$OPT("Rule","RULE",.OCXACT)," ",$$FIELD("Display a Rule")
W !
W !," ",$$OPT("Element","ELEM",.OCXACT)," ",$$FIELD("Display an Element")
W !
W !," ",$$OPT("Field","DFLD",.OCXACT)," ",$$FIELD("Display a Data Field")
W !!
;
Q
;
CENTER(X,M) ;
N SP S SP="",$P(SP," ",80)=" " Q $E(SP,1,((M\2)-($L(X)\2)))_X
;
SEP(OCXHDR) ;
;
N SPACES S SPACES="",$P(SPACES," ",200)=" " Q OCXTNLN_OCXTHLN_OCXTULN_$G(OCXHDR)_SPACES_OCXTNLN
;
FIELD(OCXHDR) ;
;
Q OCXTHLN_$G(OCXHDR)_OCXTNLN
;
DATA(OCXVAL,OCXLEN) ;
;
N SPACES S SPACES="",$P(SPACES," ",OCXLEN+5)=" ",OCXVAL=$G(OCXVAL)
I ($L(OCXVAL)>OCXLEN) Q $E(OCXVAL,1,OCXLEN-3)_"..."
Q $E((OCXVAL_SPACES),1,OCXLEN)
;
;
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
;
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)))
;
OPT(OCXSUB,OCXLN,OCXACT) ;
;
N OCXSUBC
S OCXSUBC=$TR(OCXSUB,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
Q:$D(OCXACT(OCXSUB)) ""
S OCXACT("B",OCXSUB)=""
S OCXACT(OCXSUBC)="D "_OCXLN
Q OCXTHLN_OCXTRLN_" "_OCXSUB_" "_OCXTNLN
;
RULE ;
S OCXD0=+$$DIC("^OCXS(860.2,","AEMQ") Q:'OCXD0
K IOP D ^%ZIS Q:POP
U IO W ! D EN^OCXODSP1(OCXD0,0,IOM-10) D PAUSE,^%ZISC
Q
ELEM ;
S OCXD0=+$$DIC("^OCXS(860.3,","AEMQ") Q:'OCXD0
K IOP D ^%ZIS Q:POP
U IO W ! D EN^OCXODSP2(OCXD0,0,IOM-10) D PAUSE,^%ZISC
Q
DFLD ;
S OCXD0=+$$DIC("^OCXS(860.4,","AEMQ") Q:'OCXD0
K IOP D ^%ZIS Q:POP
U IO W ! D MULT^OCXODSP3(OCXD0,0,IOM-10) D PAUSE,^%ZISC
Q
;
;
PAUSE I ($E($G(IOST),1)="C") N OCXX W !!," Press <enter> to continue... " R OCXX:DTIME
W @IOF Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOCXODSP 3419 printed Dec 13, 2024@02:25:11 Page 2
OCXODSP ;SLC/RJS,CLA - Rule Display (Expert System Display Main Screen) ;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 ;
EN ;
+1 ;
+2 NEW OCXACT,OCXOPT,IOP,OCXOFF
+3 ;
+4 IF '$DATA(IOM)
SET IOP="HOME"
DO ^%ZIS
KILL IOP
+5 SET OCXOFF=5
+6 ;
+7 FOR
KILL OCXACT
SET OCXACT=""
DO DISP(.OCXACT)
SET OCXOPT=$$GETOPT(.OCXACT)
if (OCXOPT=U)
QUIT
if $LENGTH(OCXOPT)
XECUTE OCXOPT
+8 ;
+9 QUIT
+10 ;
DISP(OCXACT) ;
+1 ;
+2 NEW OCXTHLN,OCXTNLN,OCXTRLN,OCXTULN,OCXTNLN
+3 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)
+4 ;
+5 WRITE @IOF,OCXTNLN
+6 WRITE !,$$CENTER($$FIELD("Expert System Display"),80),!
+7 IF $LENGTH($TEXT(VERSION^OCXOCMP))
WRITE !,$$CENTER($$FIELD($$VERSION^OCXOCMP),80),!
+8 WRITE !
+9 WRITE !," ",$$OPT("Rule","RULE",.OCXACT)," ",$$FIELD("Display a Rule")
+10 WRITE !
+11 WRITE !," ",$$OPT("Element","ELEM",.OCXACT)," ",$$FIELD("Display an Element")
+12 WRITE !
+13 WRITE !," ",$$OPT("Field","DFLD",.OCXACT)," ",$$FIELD("Display a Data Field")
+14 WRITE !!
+15 ;
+16 QUIT
+17 ;
CENTER(X,M) ;
+1 NEW SP
SET SP=""
SET $PIECE(SP," ",80)=" "
QUIT $EXTRACT(SP,1,((M\2)-($LENGTH(X)\2)))_X
+2 ;
SEP(OCXHDR) ;
+1 ;
+2 NEW SPACES
SET SPACES=""
SET $PIECE(SPACES," ",200)=" "
QUIT OCXTNLN_OCXTHLN_OCXTULN_$GET(OCXHDR)_SPACES_OCXTNLN
+3 ;
FIELD(OCXHDR) ;
+1 ;
+2 QUIT OCXTHLN_$GET(OCXHDR)_OCXTNLN
+3 ;
DATA(OCXVAL,OCXLEN) ;
+1 ;
+2 NEW SPACES
SET SPACES=""
SET $PIECE(SPACES," ",OCXLEN+5)=" "
SET OCXVAL=$GET(OCXVAL)
+3 IF ($LENGTH(OCXVAL)>OCXLEN)
QUIT $EXTRACT(OCXVAL,1,OCXLEN-3)_"..."
+4 QUIT $EXTRACT((OCXVAL_SPACES),1,OCXLEN)
+5 ;
+6 ;
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 ;
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 ;
OPT(OCXSUB,OCXLN,OCXACT) ;
+1 ;
+2 NEW OCXSUBC
+3 SET OCXSUBC=$TRANSLATE(OCXSUB,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+4 if $DATA(OCXACT(OCXSUB))
QUIT ""
+5 SET OCXACT("B",OCXSUB)=""
+6 SET OCXACT(OCXSUBC)="D "_OCXLN
+7 QUIT OCXTHLN_OCXTRLN_" "_OCXSUB_" "_OCXTNLN
+8 ;
RULE ;
+1 SET OCXD0=+$$DIC("^OCXS(860.2,","AEMQ")
if 'OCXD0
QUIT
+2 KILL IOP
DO ^%ZIS
if POP
QUIT
+3 USE IO
WRITE !
DO EN^OCXODSP1(OCXD0,0,IOM-10)
DO PAUSE
DO ^%ZISC
+4 QUIT
ELEM ;
+1 SET OCXD0=+$$DIC("^OCXS(860.3,","AEMQ")
if 'OCXD0
QUIT
+2 KILL IOP
DO ^%ZIS
if POP
QUIT
+3 USE IO
WRITE !
DO EN^OCXODSP2(OCXD0,0,IOM-10)
DO PAUSE
DO ^%ZISC
+4 QUIT
DFLD ;
+1 SET OCXD0=+$$DIC("^OCXS(860.4,","AEMQ")
if 'OCXD0
QUIT
+2 KILL IOP
DO ^%ZIS
if POP
QUIT
+3 USE IO
WRITE !
DO MULT^OCXODSP3(OCXD0,0,IOM-10)
DO PAUSE
DO ^%ZISC
+4 QUIT
+5 ;
+6 ;
PAUSE IF ($EXTRACT($GET(IOST),1)="C")
NEW OCXX
WRITE !!," Press <enter> to continue... "
READ OCXX:DTIME
+1 WRITE @IOF
QUIT
+2 ;
