source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXOED06.m

Last change on this file was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.1 KB
Line 
1OCXOED06 ;SLC/RJS,CLA - Rule Editor (Rule Element Relation Options) ;11/20/01 13:39
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,105**;Dec 17,1997
3 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
4 ;
5 ;
6S ;
7 ;
8 Q
9EN(OCXR0,OCXR1,OCXRD,OCXACT) ;
10 ;
11 ;
12 ;
13 N OCXTHLN,OCXTNLN,OCXTRLN,OCXTULN,OCXTNLN
14 ;
15 ;
16 S OCXOPT=$$GETOPT^OCXOEDT(.OCXACT) Q:(OCXOPT=U) 1 X:$L(OCXOPT) OCXOPT
17 ;
18 Q:'$D(^OCXS(860.2,OCXR0,"R",OCXR1)) 1
19 ;
20 Q 0
21 ;
22 ;
23EDREL(OCXR0,OCXR1) ;
24 ;
25 N OCXDA,X,OCXRD,OCXFLD,PAUSE
26 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")
27 Q:'$D(^OCXS(860.2,OCXR0,"R",OCXR1))
28 ;
29 ; Check for valid Datafield names
30 ;
31 K OCXRD S OCXRD="" D GETDATA^OCXOED05(OCXR0,OCXR1,.OCXRD)
32 F OCXFLD=5,6,8,9 D
33 .N NEWVAL,OLDVAL,FLDNAME
34 .S FLDNAME=$S((OCXFLD=5):"Notification Message",(OCXFLD=6):"Order Check Message",1:"")
35 .S OLDVAL=$G(OCXRD("REL",OCXR1,OCXFLD,"E")) Q:'$L(OLDVAL)
36 .S NEWVAL=$$SCREEN^OCXOED12(OLDVAL,FLDNAME) Q:(NEWVAL=OLDVAL)
37 .S OCXDA(1)=OCXR0,OCXDA=OCXR1,X=$$DIE("^OCXS(860.2,"_OCXR0_",""R"",",.OCXDA,OCXFLD_"///"_NEWVAL)
38 ;
39 ; Check for valid Mumps Code
40 ;
41 W !!," Mumps Code Check",!!
42 K OCXRD S OCXRD="" D GETDATA^OCXOED05(OCXR0,OCXR1,.OCXRD)
43 F OCXFLD=9 D
44 .N NEWVAL,OLDVAL,FLDNAME,FCNT,X
45 .S FLDNAME=$S((OCXFLD=9):"Execute Code",1:"")
46 .S OLDVAL=$G(OCXRD("REL",OCXR1,OCXFLD,"E")) Q:'$L(OLDVAL)
47 .S PAUSE=1
48 .S NEWVAL=OLDVAL
49 .F FCNT=1:1 Q:'(NEWVAL["|") S NEWVAL=$P(NEWVAL,"|",1)_"X"_FCNT_$P(NEWVAL,"|",3,$L(NEWVAL,"|"))
50 .W !,FLDNAME,": ",OLDVAL
51 .S X=NEWVAL D ^DIM
52 .I '$D(X) D Q
53 ..W !
54 ..W !,"**WARNING** The mumps code: ",OLDVAL
55 ..W !," Did not pass the mumps syntax check. Please verify that this is valid"
56 ..W !,"mumps code before you run the compiler."
57 .W !,?10," Code OK !!"
58 ;
59 S:PAUSE X=$$PAUSE
60 ;
61 Q
62 ;
63 ;
64PAUSE() N X W !!," Press <enter> to continue... " R X:DTIME W ! Q ((X[U)*10)
65 ;
66 ;
67 ;
68READ(OCXZ0,OCXZA,OCXZB,OCXZL) ;
69 N OCXLINE,DIR,DTOUT,DUOUT,DIRUT,DIROUT
70 Q:'$L($G(OCXZ0)) U
71 S DIR(0)=OCXZ0
72 S:$L($G(OCXZA)) DIR("A")=OCXZA
73 S:$L($G(OCXZB)) DIR("B")=OCXZB
74 F OCXLINE=1:1:($G(OCXZL)-1) W !
75 D ^DIR
76 I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) Q U
77 Q Y
78 ;
79DIE(DIE,DA,DR) ;
80 ;
81 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
82 ;
83RM(X) X ^%ZOSF("RM") Q
84 ;
85DIC(OCXDIC,OCXDIC0,OCXDICA,OCXX,OCXDICS,OCXDR,DA) ;
86 ;
87 N DIC,X,Y
88 S DIC=$G(OCXDIC) Q:'$L(DIC) -1
89 S DIC(0)=$G(OCXDIC0) S:$L($G(OCXX)) X=OCXX
90 S:$L($G(OCXDICS)) DIC("S")=OCXDICS
91 S:$L($G(OCXDICA)) DIC("A")=OCXDICA
92 S:$L($G(OCXDR)) DIC("DR")=OCXDR
93 D ^DIC Q:(Y<1) 0 Q Y
94 ;
95INVALID(X) ;
96 ;
97 N OCXFN
98 ;
99 F OCXFN=1:1 Q:'(X["|") D Q:'$L(X)
100 .N OCXDF
101 .S OCXDF=$P(X,"|",2)
102 .I '$L(OCXDF) S X="" Q
103 .I '$O(^OCXS(860.4,"B",OCXDF,0)),'$O(^OCXS(860.4,"C",OCXDF,0)) S X="" Q
104 .S X=$P(X,"|",1)_"DFLD"_OCXFN_$P(X,"|",3,$L(X,"|"))
105 ;
106 Q:'$L(X) 1
107 ;
108 D ^DIM
109 ;
110 Q '$L($G(X))
111 ;
112ETEST ;
113 ;
114 N D0,D1,EXP
115 ;
116 S D0=0 F S D0=$O(^OCXS(860.2,D0)) Q:'D0 D
117 .W !,$P(^OCXS(860.2,D0,0),U,1)
118 .S D1=0 F S D1=$O(^OCXS(860.2,D0,"R",D1)) Q:'D1 D
119 ..S EXP=$G(^OCXS(860.2,D0,"R",D1,"MCODE"))
120 ..Q:'$L(EXP)
121 ..W !,?10,D1," ",EXP
122 ..I $$INVALID(EXP) W " ** Invalid Code ** "
123 Q
124 ;
Note: See TracBrowser for help on using the repository browser.