Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: OCXOED06

OCXOED06.m

Go to the documentation of this file.
  1. OCXOED06 ;SLC/RJS,CLA - Rule Editor (Rule Element Relation Options) ;11/20/01 13:39
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,105**;Dec 17,1997
  1. ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
  1. ;
  1. ;
  1. S ;
  1. ;
  1. Q
  1. EN(OCXR0,OCXR1,OCXRD,OCXACT) ;
  1. ;
  1. ;
  1. ;
  1. N OCXTHLN,OCXTNLN,OCXTRLN,OCXTULN,OCXTNLN
  1. ;
  1. ;
  1. S OCXOPT=$$GETOPT^OCXOEDT(.OCXACT) Q:(OCXOPT=U) 1 X:$L(OCXOPT) OCXOPT
  1. ;
  1. Q:'$D(^OCXS(860.2,OCXR0,"R",OCXR1)) 1
  1. ;
  1. Q 0
  1. ;
  1. ;
  1. EDREL(OCXR0,OCXR1) ;
  1. ;
  1. N OCXDA,X,OCXRD,OCXFLD,PAUSE
  1. S PAUSE=0,OCXDA(1)=OCXR0,OCXDA=OCXR1,X=$$DIE("^OCXS(860.2,"_OCXR0_",""R"",",.OCXDA,"1;2;3;4;5;6;7;8;9")
  1. Q:'$D(^OCXS(860.2,OCXR0,"R",OCXR1))
  1. ;
  1. ; Check for valid Datafield names
  1. ;
  1. K OCXRD S OCXRD="" D GETDATA^OCXOED05(OCXR0,OCXR1,.OCXRD)
  1. F OCXFLD=5,6,8,9 D
  1. .N NEWVAL,OLDVAL,FLDNAME
  1. .S FLDNAME=$S((OCXFLD=5):"Notification Message",(OCXFLD=6):"Order Check Message",1:"")
  1. .S OLDVAL=$G(OCXRD("REL",OCXR1,OCXFLD,"E")) Q:'$L(OLDVAL)
  1. .S NEWVAL=$$SCREEN^OCXOED12(OLDVAL,FLDNAME) Q:(NEWVAL=OLDVAL)
  1. .S OCXDA(1)=OCXR0,OCXDA=OCXR1,X=$$DIE("^OCXS(860.2,"_OCXR0_",""R"",",.OCXDA,OCXFLD_"///"_NEWVAL)
  1. ;
  1. ; Check for valid Mumps Code
  1. ;
  1. W !!," Mumps Code Check",!!
  1. K OCXRD S OCXRD="" D GETDATA^OCXOED05(OCXR0,OCXR1,.OCXRD)
  1. F OCXFLD=9 D
  1. .N NEWVAL,OLDVAL,FLDNAME,FCNT,X
  1. .S FLDNAME=$S((OCXFLD=9):"Execute Code",1:"")
  1. .S OLDVAL=$G(OCXRD("REL",OCXR1,OCXFLD,"E")) Q:'$L(OLDVAL)
  1. .S PAUSE=1
  1. .S NEWVAL=OLDVAL
  1. .F FCNT=1:1 Q:'(NEWVAL["|") S NEWVAL=$P(NEWVAL,"|",1)_"X"_FCNT_$P(NEWVAL,"|",3,$L(NEWVAL,"|"))
  1. .W !,FLDNAME,": ",OLDVAL
  1. .S X=NEWVAL D ^DIM
  1. .I '$D(X) D Q
  1. ..W !
  1. ..W !,"**WARNING** The mumps code: ",OLDVAL
  1. ..W !," Did not pass the mumps syntax check. Please verify that this is valid"
  1. ..W !,"mumps code before you run the compiler."
  1. .W !,?10," Code OK !!"
  1. ;
  1. S:PAUSE X=$$PAUSE
  1. ;
  1. Q
  1. ;
  1. ;
  1. PAUSE() N X W !!," Press <enter> to continue... " R X:DTIME W ! Q ((X[U)*10)
  1. ;
  1. ;
  1. ;
  1. READ(OCXZ0,OCXZA,OCXZB,OCXZL) ;
  1. N OCXLINE,DIR,DTOUT,DUOUT,DIRUT,DIROUT
  1. Q:'$L($G(OCXZ0)) U
  1. S DIR(0)=OCXZ0
  1. S:$L($G(OCXZA)) DIR("A")=OCXZA
  1. S:$L($G(OCXZB)) DIR("B")=OCXZB
  1. F OCXLINE=1:1:($G(OCXZL)-1) W !
  1. D ^DIR
  1. I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) Q U
  1. Q Y
  1. ;
  1. DIE(DIE,DA,DR) ;
  1. ;
  1. D RM(IOM) N DUOUT,DTOUT,DIC S DIC=DIE D ^DIE D RM(0) Q:$G(DTOUT) 0 Q:$G(DUOUT) 0 Q 1
  1. ;
  1. RM(X) X ^%ZOSF("RM") Q
  1. ;
  1. DIC(OCXDIC,OCXDIC0,OCXDICA,OCXX,OCXDICS,OCXDR,DA) ;
  1. ;
  1. N DIC,X,Y
  1. S DIC=$G(OCXDIC) Q:'$L(DIC) -1
  1. S DIC(0)=$G(OCXDIC0) S:$L($G(OCXX)) X=OCXX
  1. S:$L($G(OCXDICS)) DIC("S")=OCXDICS
  1. S:$L($G(OCXDICA)) DIC("A")=OCXDICA
  1. S:$L($G(OCXDR)) DIC("DR")=OCXDR
  1. D ^DIC Q:(Y<1) 0 Q Y
  1. ;
  1. INVALID(X) ;
  1. ;
  1. N OCXFN
  1. ;
  1. F OCXFN=1:1 Q:'(X["|") D Q:'$L(X)
  1. .N OCXDF
  1. .S OCXDF=$P(X,"|",2)
  1. .I '$L(OCXDF) S X="" Q
  1. .I '$O(^OCXS(860.4,"B",OCXDF,0)),'$O(^OCXS(860.4,"C",OCXDF,0)) S X="" Q
  1. .S X=$P(X,"|",1)_"DFLD"_OCXFN_$P(X,"|",3,$L(X,"|"))
  1. ;
  1. Q:'$L(X) 1
  1. ;
  1. D ^DIM
  1. ;
  1. Q '$L($G(X))
  1. ;
  1. ETEST ;
  1. ;
  1. N D0,D1,EXP
  1. ;
  1. S D0=0 F S D0=$O(^OCXS(860.2,D0)) Q:'D0 D
  1. .W !,$P(^OCXS(860.2,D0,0),U,1)
  1. .S D1=0 F S D1=$O(^OCXS(860.2,D0,"R",D1)) Q:'D1 D
  1. ..S EXP=$G(^OCXS(860.2,D0,"R",D1,"MCODE"))
  1. ..Q:'$L(EXP)
  1. ..W !,?10,D1," ",EXP
  1. ..I $$INVALID(EXP) W " ** Invalid Code ** "
  1. Q
  1. ;