- Timestamp:
- Dec 4, 2009, 12:11:15 AM (15 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXOCMP.m
r613 r623 1 OCXOCMP ;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,243**;Dec 17,1997;Build 242 3 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998 4 ; 5 EN ; 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 ; 15 MAN K ZTSK D MAN^OCXOCMPV Q ; Run the compiler (interactive/manual mode) 16 ; ; Ask for option settings. 17 ; 18 AUTO 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 ; 23 QUE 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. 27 RUN ; 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 ; 143 D:($G(OCXAUTO)<2) STATUS^OCXOPOST(20,20) 144 ; 145 L -^OCXD(861,1) 146 ; 147 Q 148 ; 149 MESG(OCXX) ; 150 I '$G(OCXAUTO) W !!,OCXX 151 I ($G(OCXAUTO)=1) D BMES^XPDUTL(.OCXX) 152 Q 153 ; 154 ERMESG(OCXX) ; 155 N OCXY S OCXY=OCXX 156 I '$G(OCXAUTO) W !!,OCXX 157 I ($G(OCXAUTO)=1) D BMES^XPDUTL(.OCXX) 158 S OCXERRM=OCXY 159 Q 160 ; 161 READ(OCXZ0,OCXZA,OCXZB,OCXZL) ; 162 N OCXLINE,DIR,DTOUT,DUOUT,DIRUT,DIROUT 163 Q:'$L($G(OCXZ0)) U 164 S DIR(0)=OCXZ0 165 S:$L($G(OCXZA)) DIR("A")=OCXZA 166 S:$L($G(OCXZB)) DIR("B")=OCXZB 167 F OCXLINE=1:1:($G(OCXZL)-1) W ! 168 D ^DIR 169 I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) Q U 170 Q Y 171 ; 172 Q 173 ; 174 DT(X,D) N Y,%DT S %DT=D D ^%DT Q Y 175 Q 176 ; 177 CNT(X) ; 178 ; 179 N CNT,D0 180 S D0=0 F CNT=1:1 S D0=$O(@X@(D0)) Q:'D0 181 W !!,?10,X," ",CNT 182 Q CNT 183 ; 184 DATE() N X,Y,%DT S X="N",%DT="T" D ^%DT X ^DD("DD") Q Y 185 ; 186 CONV(Y) Q:'(Y["@") Y Q $P(Y,"@",1)_" at "_$P(Y,"@",2,99) 187 ; 188 ; 189 VERSION() Q $P($T(+3),";;",3) 190 ; 1 OCXOCMP ;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 ; 5 EN ; 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 ; 15 MAN K ZTSK D MAN^OCXOCMPV Q ; Run the compiler (interactive/manual mode) 16 ; ; Ask for option settings. 17 ; 18 AUTO 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 ; 23 QUE 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. 27 RUN ; 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 ; 150 MESG(OCXX) ; 151 I '$G(OCXAUTO) W !!,OCXX 152 I ($G(OCXAUTO)=1) D BMES^XPDUTL(.OCXX) 153 Q 154 ; 155 ERMESG(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 ; 162 READ(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 ; 175 DT(X,D) N Y,%DT S %DT=D D ^%DT Q Y 176 Q 177 ; 178 CNT(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 ; 185 DATE() N X,Y,%DT S X="N",%DT="T" D ^%DT X ^DD("DD") Q Y 186 ; 187 CONV(Y) Q:'(Y["@") Y Q $P(Y,"@",1)_" at "_$P(Y,"@",2,99) 188 ; 189 ; 190 VERSION() Q $P($T(+3),";;",3) 191 ;
Note:
See TracChangeset
for help on using the changeset viewer.
