OCXOED16 ;SLC/RJS,CLA - Rule Editor (Expert System Editor Options) ;6/19/01 16:35
;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,105**;Dec 17,1997
;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
;
;
S ;
;
Q
EN(OCXACT) ;
;
;
N OCXTHLN,OCXTNLN,OCXTRLN,OCXTULN,OCXTNLN
;
S OCXOPT=$$GETOPT^OCXOEDT(.OCXACT) Q:(OCXOPT=U) 1 X:$L(OCXOPT) OCXOPT
;
Q 0
;
EDRULE ;
;
N OCXY F W !! S OCXY=+$$DIC("^OCXS(860.2,","AEMQNL","Select Rule: ") Q:'OCXY D EN^OCXOED01(OCXY)
;
Q
;
EDELEM ;
;
N OCXY F W !! S OCXY=+$$DIC("^OCXS(860.3,","AEMQNL","Select Element: ") Q:'OCXY D EN^OCXOED07(OCXY)
;
Q
;
EDDF ;
;
N OCXY F W !! S OCXY=+$$DIC("^OCXS(860.4,","AEMQNL","Select Data Field: ") Q:'OCXY D EN^OCXOED11(OCXY)
;
Q
;
EDMDD ;
;
N OCXY F W !! S OCXY=$$DIC("^OCXS(863.3,","AEMQNL","Select Link: ") Q:'OCXY D EN^OCXOED13($P(OCXY,U,2))
;
Q
;
COMP D ^OCXOCMP Q
;
SCANDF D SELECT^OCXOSCR1 Q
;
SCANEL D SELECT^OCXOSCR2 Q
;
EDPARAM(OCXD0,PARNAM) ;
;
N NEWVAL
W !!
W " ",$$FIELD("Link Parameter -> "_PARNAM_": ")
W:$L($$GLPVAL(OCXD0,PARNAM)) $$GLPVAL(OCXD0,PARNAM)_" // "
R NEWVAL:30 E Q
I (NEWVAL="@") W ! Q:'$$READ("Y","Are you sure you want to delete this value ?","YES")
D SLPVAL(OCXD0,PARNAM,NEWVAL)
Q
;
GLPVAL(OCXD0,PNAME) ;
N X S X="" F S X=$O(OCXRD("LINK",OCXD0,"PAR",X)) Q:'X I ($G(OCXRD("LINK",OCXD0,"PAR",X,.01,"E"))=PNAME) Q
Q:'X "" Q $G(OCXRD("LINK",OCXD0,"PAR",X,1,"E"))
;
SLPVAL(OCXD0,PNAME,PVAL) ;
N DA,OCXY,OCXZ
S DA(1)=OCXD0,OCXY=+$$DIC("^OCXS(863.3,"_OCXD0_",""PAR"",","ML","",PNAME,"","",.DA) Q:(OCXY<1)
S DA(1)=OCXD0,DA=+OCXY,OCXZ=$$DIE("^OCXS(863.3,"_OCXD0_",""PAR"",",.DA,1,PVAL)
Q
;
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)
;
READ(OCXZ0,OCXZA,OCXZB,OCXZL) ;
N OCXLINE,DIR,DTOUT,DUOUT,DIRUT,DIROUT
Q:'$L($G(OCXZ0)) U
S DIR(0)=OCXZ0
S:$L($G(OCXZA)) DIR("A")=OCXZA
S:$L($G(OCXZB)) DIR("B")=OCXZB
F OCXLINE=1:1:($G(OCXZL)-1) W !
D ^DIR
I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) Q U
Q Y
;
DIE(DIE,DA,OCXFLD,OCXVAL) ;
;
N DUOUT,DTOUT,DIC
S DR=OCXFLD_"///^S X=OCXVAL"
S DIC=DIE D RM(IOM) D ^DIE D RM(0) Q:$G(DTOUT) 0 Q:$G(DUOUT) 0 Q 1
;
RM(X) X ^%ZOSF("RM") Q
;
DIC(OCXDIC,OCXDIC0,OCXDICA,OCXX,OCXDICS,OCXDR,DA) ;
;
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
;
OCXOED16 ;SLC/RJS,CLA - Rule Editor (Expert System Editor Options) ;6/19/01 16:35
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,105**;Dec 17,1997
+2 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
+3 ;
+4 ;
S ;
+1 ;
+2 QUIT
EN(OCXACT) ;
+1 ;
+2 ;
+3 NEW OCXTHLN,OCXTNLN,OCXTRLN,OCXTULN,OCXTNLN
+4 ;
+5 SET OCXOPT=$$GETOPT^OCXOEDT(.OCXACT)
IF (OCXOPT=U)
QUIT 1
IF $LENGTH(OCXOPT)
XECUTE OCXOPT
+6 ;
+7 QUIT 0
+8 ;
EDRULE ;
+1 ;
+2 NEW OCXY
FOR
WRITE !!
SET OCXY=+$$DIC("^OCXS(860.2,","AEMQNL","Select Rule: ")
IF 'OCXY
QUIT
DO EN^OCXOED01(OCXY)
+3 ;
+4 QUIT
+5 ;
EDELEM ;
+1 ;
+2 NEW OCXY
FOR
WRITE !!
SET OCXY=+$$DIC("^OCXS(860.3,","AEMQNL","Select Element: ")
IF 'OCXY
QUIT
DO EN^OCXOED07(OCXY)
+3 ;
+4 QUIT
+5 ;
EDDF ;
+1 ;
+2 NEW OCXY
FOR
WRITE !!
SET OCXY=+$$DIC("^OCXS(860.4,","AEMQNL","Select Data Field: ")
IF 'OCXY
QUIT
DO EN^OCXOED11(OCXY)
+3 ;
+4 QUIT
+5 ;
EDMDD ;
+1 ;
+2 NEW OCXY
FOR
WRITE !!
SET OCXY=$$DIC("^OCXS(863.3,","AEMQNL","Select Link: ")
IF 'OCXY
QUIT
DO EN^OCXOED13($PIECE(OCXY,U,2))
+3 ;
+4 QUIT
+5 ;
COMP DO ^OCXOCMP
QUIT
+1 ;
SCANDF DO SELECT^OCXOSCR1
QUIT
+1 ;
SCANEL DO SELECT^OCXOSCR2
QUIT
+1 ;
EDPARAM(OCXD0,PARNAM) ;
+1 ;
+2 NEW NEWVAL
+3 WRITE !!
+4 WRITE " ",$$FIELD("Link Parameter -> "_PARNAM_": ")
+5 IF $LENGTH($$GLPVAL(OCXD0,PARNAM))
WRITE $$GLPVAL(OCXD0,PARNAM)_" // "
+6 READ NEWVAL:30
IF '$TEST
QUIT
+7 IF (NEWVAL="@")
WRITE !
IF '$$READ("Y","Are you sure you want to delete this value ?","YES")
QUIT
+8 DO SLPVAL(OCXD0,PARNAM,NEWVAL)
+9 QUIT
+10 ;
GLPVAL(OCXD0,PNAME) ;
+1 NEW X
SET X=""
FOR
SET X=$ORDER(OCXRD("LINK",OCXD0,"PAR",X))
IF 'X
QUIT
IF ($GET(OCXRD("LINK",OCXD0,"PAR",X,.01,"E"))=PNAME)
QUIT
+2 IF 'X
QUIT ""
QUIT $GET(OCXRD("LINK",OCXD0,"PAR",X,1,"E"))
+3 ;
SLPVAL(OCXD0,PNAME,PVAL) ;
+1 NEW DA,OCXY,OCXZ
+2 SET DA(1)=OCXD0
SET OCXY=+$$DIC("^OCXS(863.3,"_OCXD0_",""PAR"",","ML","",PNAME,"","",.DA)
IF (OCXY<1)
QUIT
+3 SET DA(1)=OCXD0
SET DA=+OCXY
SET OCXZ=$$DIE("^OCXS(863.3,"_OCXD0_",""PAR"",",.DA,1,PVAL)
+4 QUIT
+5 ;
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 ;
READ(OCXZ0,OCXZA,OCXZB,OCXZL) ;
+1 NEW OCXLINE,DIR,DTOUT,DUOUT,DIRUT,DIROUT
+2 IF '$LENGTH($GET(OCXZ0))
QUIT U
+3 SET DIR(0)=OCXZ0
+4 IF $LENGTH($GET(OCXZA))
SET DIR("A")=OCXZA
+5 IF $LENGTH($GET(OCXZB))
SET DIR("B")=OCXZB
+6 FOR OCXLINE=1:1:($GET(OCXZL)-1)
WRITE !
+7 DO ^DIR
+8 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
QUIT U
+9 QUIT Y
+10 ;
DIE(DIE,DA,OCXFLD,OCXVAL) ;
+1 ;
+2 NEW DUOUT,DTOUT,DIC
+3 SET DR=OCXFLD_"///^S X=OCXVAL"
+4 SET DIC=DIE
DO RM(IOM)
DO ^DIE
DO RM(0)
IF $GET(DTOUT)
QUIT 0
IF $GET(DUOUT)
QUIT 0
QUIT 1
+5 ;
RM(X) XECUTE ^%ZOSF("RM")
QUIT
+1 ;
DIC(OCXDIC,OCXDIC0,OCXDICA,OCXX,OCXDICS,OCXDR,DA) ;
+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 ;
