source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXOCMP.m@ 1195

Last change on this file since 1195 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version
File size: 5.9 KB
Line 
1OCXOCMP ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Main Entry point - All Rules) ;3/21/01 08:50
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,105**;Dec 17,1997
3 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
4 ;
5EN ;
6 ;
7 N OCXQ
8 ;
9 S OCXQ=$$READ("Y","Do you want to queue the compiler to run ","NO") Q:(OCXQ[U) I OCXQ D Q
10 .D QUE^OCXOCMPV(10)
11 .W !!,"Expert system compiler queued to run in 10 seconds."
12 .W !,"You will be sent a Mailman bulletin when it has finished.",!!
13 .H 2
14 ;
15MAN K ZTSK D MAN^OCXOCMPV Q ; Run the compiler (interactive/manual mode)
16 ; ; Ask for option settings.
17 ;
18AUTO D AUTO^OCXOCMPV Q ; Run the compiler (Automatic mode)
19 ; ; Program Execution Trace Mode OFF
20 ; ; Elapsed time logging OFF
21 ; ; Raw Data Logging OFF
22 ;
23QUE D QUE^OCXOCMPV(10) Q ; Queue the compiler to run in the background
24 ; ; Uses option setting from last compile.
25 ; ; If no last compile then all options are
26 ; ; turned OFF as in Automatic mode.
27RUN ;
28 ;
29 N OCX1,OCX2,OCX3,OCX4
30 ;
31 D:($G(OCXAUTO)<2) STATUS^OCXOPOST(1,20)
32 ;
33 D MESG("Build list of Active Rules, Elements and Datafields...")
34 D SETFLAG^OCXOCMPV ; H 1
35 I $$EN^OCXOCMP9 D ERMESG("Compiler Aborted while building list of Rules, Elements and Datafields...") Q
36 Q:$G(OCXWARN)
37 ;
38 D:($G(OCXAUTO)<2) STATUS^OCXOPOST(2,20)
39 ;
40 S OCX1="" F S OCX1=$O(^TMP("OCXCMP",$J,OCX1)) Q:'$L(OCX1) D
41 .S OCX2=0 F OCX3=0:1 S OCX2=$O(^TMP("OCXCMP",$J,OCX1,OCX2)) Q:'OCX2
42 .D MESG(" "_$J(OCX3,5)_" "_OCX1_$S(OCX3=1:"",1:"S"))
43 ;
44 D:($G(OCXAUTO)<2) STATUS^OCXOPOST(3,20)
45 ;
46 D MESG("Compile DataField Navigation code...")
47 D SETFLAG^OCXOCMPV ; H 1
48 I $$EN^OCXOCMP1 D ERMESG("Compiler Aborted due to Datafield syntax errors...") Q
49 Q:$G(OCXWARN)
50 ;
51 D:($G(OCXAUTO)<2) STATUS^OCXOPOST(4,20)
52 ;
53 S (OCX3,OCX1)=0 F S OCX1=$O(^TMP("OCXCMP",$J,"DATA FIELD",OCX1)) Q:'OCX1 D
54 .S OCX2=0 F S OCX2=$O(^TMP("OCXCMP",$J,"DATA FIELD",OCX1,OCX2)) Q:'OCX2 S OCX3=OCX3+1
55 D MESG(" "_$J(OCX3,5)_" DataField Navigation Code Array"_$S(OCX3=1:"",1:"s"))
56 ;
57 D:($G(OCXAUTO)<2) STATUS^OCXOPOST(5,20)
58 ;
59 D MESG("Compile Element Evaluation code...")
60 D SETFLAG^OCXOCMPV ; H 1
61 I $$EN^OCXOCMP2 D ERMESG("Compiler Aborted due to Rule Element syntax errors...") Q
62 Q:$G(OCXWARN)
63 ;
64 D:($G(OCXAUTO)<2) STATUS^OCXOPOST(6,20)
65 ;
66 S (OCX1,OCX2)=0 F S OCX1=$O(^TMP("OCXCMP",$J,"A CODE",OCX1)) Q:'OCX1 S OCX2=OCX2+1
67 D MESG(" "_$J(OCX2,5)_" Event Evaluation Code Array"_$S(OCX2=1:"",1:"s"))
68 ;
69 D:($G(OCXAUTO)<2) STATUS^OCXOPOST(7,20)
70 ;
71 D MESG("Compile Element MetaCode...")
72 D SETFLAG^OCXOCMPV ; H 1
73 I $$EN^OCXOCMPM D ERMESG("Compiler Aborted due to Element metacode errors...") Q
74 Q:$G(OCXWARN)
75 ;
76 D:($G(OCXAUTO)<2) STATUS^OCXOPOST(8,20)
77 ;
78 S OCX1="",OCX2=0 F S OCX1=$O(^TMP("OCXCMP",$J,"INCLUDE",OCX1)) Q:'$L(OCX1) S:($E(OCX1,1,3)="MCE") OCX2=OCX2+1
79 D MESG(" "_$J(OCX2,5)_" Element Metacode Array"_$S(OCX2=1:"",1:"s"))
80 ;
81 D:($G(OCXAUTO)<2) STATUS^OCXOPOST(9,20)
82 ;
83 D MESG("Get Compiler Function Code...")
84 D SETFLAG^OCXOCMPV ; H 1
85 I $$EN^OCXOCMPO D ERMESG("Compiler Aborted due to Compiler Function code errors...") Q
86 Q:$G(OCXWARN)
87 ;
88 D:($G(OCXAUTO)<2) STATUS^OCXOPOST(10,20)
89 ;
90 S OCX1="",OCX2=0 F S OCX1=$O(^TMP("OCXCMP",$J,"INCLUDE",OCX1)) Q:'$L(OCX1) S:'($E(OCX1,1,3)="MCE") OCX2=OCX2+1
91 D MESG(" "_$J(OCX2,5)_" Compiler Include Function"_$S(OCX2=1:"",1:"s"))
92 ;
93 D:($G(OCXAUTO)<2) STATUS^OCXOPOST(12,20)
94 ;
95 D MESG("Compile Rule Element Relation code...")
96 D SETFLAG^OCXOCMPV ; H 1
97 I $$EN^OCXOCMP3 D ERMESG("Compiler Aborted due to Rule syntax errors...") Q
98 Q:$G(OCXWARN)
99 ;
100 D:($G(OCXAUTO)<2) STATUS^OCXOPOST(13,20)
101 ;
102 S (OCX1,OCX2)=0 F S OCX1=$O(^TMP("OCXCMP",$J,"RULE",OCX1)) Q:'OCX1 D
103 .S OCX3=0 F S OCX3=$O(^TMP("OCXCMP",$J,"RULE",OCX1,OCX3)) Q:'OCX3 S:$O(^(OCX3,"CODE",0)) OCX2=OCX2+1
104 D MESG(" "_$J(OCX2,5)_" Rule Element Relation Code Array"_$S(OCX2=1:"",1:"s"))
105 ;
106 D:($G(OCXAUTO)<2) STATUS^OCXOPOST(14,20)
107 ;
108 D MESG("Construct Decision Tree...")
109 D SETFLAG^OCXOCMPV ; H 1
110 I $$EN^OCXOCMP4 D ERMESG("Compiler Aborted due to Compiler errors...") Q
111 Q:$G(OCXWARN)
112 ;
113 D:($G(OCXAUTO)<2) STATUS^OCXOPOST(15,20)
114 ;
115 S OCX1=0 F OCX2=0:1 S OCX1=$O(^TMP("OCXCMP",$J,"C CODE",OCX1)) Q:'OCX1
116 D MESG(" "_$J(OCX2,5)_" Sub-Routine"_$S(OCX2=1:"",1:"s"))
117 ;
118 D:($G(OCXAUTO)<2) STATUS^OCXOPOST(16,20)
119 ;
120 D MESG("Optimize Sub-Routines...")
121 D SETFLAG^OCXOCMPV ; H 1
122 I $$EN^OCXOCMP5 D ERMESG("Compiler Aborted due to Compiler errors...") Q
123 Q:$G(OCXWARN)
124 ;
125 D:($G(OCXAUTO)<2) STATUS^OCXOPOST(17,20)
126 ;
127 S OCX1=0 F OCX3=0:1 S OCX1=$O(^TMP("OCXCMP",$J,"C CODE",OCX1)) Q:'OCX1
128 D MESG(" "_$J(OCX3,5)_" Sub-Routine"_$S(OCX3=1:"",1:"s"))
129 D MESG(" "_(100-(((OCX3/OCX2)*1000)\1/10))_"% Optimization")
130 ;
131 D:($G(OCXAUTO)<2) STATUS^OCXOPOST(18,20)
132 ;
133 D MESG("Assemble Routines...")
134 D SETFLAG^OCXOCMPV ; H 1
135 I $$EN^OCXOCMP6 D ERMESG("Compiler Aborted due to Compiler errors...") Q
136 Q:$G(OCXWARN)
137 ;
138 D:($G(OCXAUTO)<2) STATUS^OCXOPOST(19,20)
139 ;
140 S OCX1=0 F OCX2=0:1 S OCX1=$O(^TMP("OCXCMP",$J,"D CODE",OCX1)) Q:'OCX1
141 D MESG(" "_$J(OCX2,5)_" OCXOZ* Routine"_$S(OCX2=1:"",1:"s"))
142 D MESG(" "_OCXLCNT_" Lines of code generated.")
143 ;
144 D:($G(OCXAUTO)<2) STATUS^OCXOPOST(20,20)
145 ;
146 L -^OCXD(861,1)
147 ;
148 Q
149 ;
150MESG(OCXX) ;
151 I '$G(OCXAUTO) W !!,OCXX
152 I ($G(OCXAUTO)=1) D BMES^XPDUTL(.OCXX)
153 Q
154 ;
155ERMESG(OCXX) ;
156 N OCXY S OCXY=OCXX
157 I '$G(OCXAUTO) W !!,OCXX
158 I ($G(OCXAUTO)=1) D BMES^XPDUTL(.OCXX)
159 S OCXERRM=OCXY
160 Q
161 ;
162READ(OCXZ0,OCXZA,OCXZB,OCXZL) ;
163 N OCXLINE,DIR,DTOUT,DUOUT,DIRUT,DIROUT
164 Q:'$L($G(OCXZ0)) U
165 S DIR(0)=OCXZ0
166 S:$L($G(OCXZA)) DIR("A")=OCXZA
167 S:$L($G(OCXZB)) DIR("B")=OCXZB
168 F OCXLINE=1:1:($G(OCXZL)-1) W !
169 D ^DIR
170 I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) Q U
171 Q Y
172 ;
173 Q
174 ;
175DT(X,D) N Y,%DT S %DT=D D ^%DT Q Y
176 Q
177 ;
178CNT(X) ;
179 ;
180 N CNT,D0
181 S D0=0 F CNT=1:1 S D0=$O(@X@(D0)) Q:'D0
182 W !!,?10,X," ",CNT
183 Q CNT
184 ;
185DATE() N X,Y,%DT S X="N",%DT="T" D ^%DT X ^DD("DD") Q Y
186 ;
187CONV(Y) Q:'(Y["@") Y Q $P(Y,"@",1)_" at "_$P(Y,"@",2,99)
188 ;
189 ;
190VERSION() Q $P($T(+3),";;",3)
191 ;
Note: See TracBrowser for help on using the repository browser.