source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXOCMPV.m@ 1177

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

revised back to 6/30/08 version

File size: 7.0 KB
Line 
1OCXOCMPV ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Main Entry point - All Rules cont...) ;1/05/04 14:09
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,105,221**;Dec 17,1997
3 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
4 ;
5MAN ;
6 I '$D(DUZ) W !!,"DUZ not defined." Q
7 N OCXD0,OCXD1,OCXWARN,OCXNAM,OCXTRACE,OCXOETIM,OCXLCNT,OCXAUTO,OCXERRM,OCXTSPI
8 S OCXWARN=0,OCXOETIM=$H
9 K ^TMP("OCXCMP",$J)
10 S ^TMP("OCXCMP",$J)=($P($H,",",2)+($H*86400)+(2*60*60))_" <- ^TMP ENTRY EXPIRATION DATE FOR ^OCXOPURG"
11 ;
12 ; Compiler Constants
13 ;
14 S OCXCLL=200 ; compiled code line length
15 S OCXCRS=4000 ; compiled routine size
16 S OCXTSPI=300 ; Duplicate triggered Rule message "ignore period" in seconds
17 ;
18 S OCXTRACE=0,OCXTLOG=0,OCXDLOG=0,OCXAUTO=0,OCXERRM=""
19 ;
20 S OCXTRACE=$$READ("Y","Want to enable Compiled Routine Execution Display ","NO") Q:(OCXTRACE[U)
21 S OCXDLOG=$$READ("Y","Want to enable Logging of incoming raw data ","NO") Q:(OCXDLOG[U)
22 I OCXDLOG S OCXDLOG=$$READ("N^1:20","Number of days to keep raw data ","3") Q:(OCXDLOG[U)
23 I OCXDLOG W !!,"*** Note: The raw data log will only hold 200,000 entries. *****",!
24 I 0 I OCXDLOG S OCXTLOG=$$READ("Y","Want to enable Elapsed Time Logging ","YES") Q:(OCXTLOG[U)
25 ;
26 Q:'$$READ("Y","Are you sure you want to recompile the Expert System routines ","NO")
27 ;
28 D SETFLAG
29 L +^OCXD(861,1):5 E D ERMESG("Run aborted. Another compiler run has ^OCXD(861,1) locked.") Q
30 D RUN^OCXOCMP,BULL(DUZ),KILLFLAG
31 L -^OCXD(861,1)
32 ;
33 ;K ^TMP("OCXCMP",$J)
34 ;
35 Q
36 ;
37MESG(OCXX) ;
38 I '$G(OCXAUTO) W !!,OCXX
39 I ($G(OCXAUTO)=1) D BMES^XPDUTL(.OCXX)
40 Q
41 ;
42ERMESG(OCXX) ;
43 N OCXY S OCXY=OCXX
44 I '$G(OCXAUTO) W !!,OCXX
45 I ($G(OCXAUTO)=1) D BMES^XPDUTL(.OCXX)
46 S OCXERRM=OCXY
47 Q
48 ;
49WARN(X,FILE,D0,RLINE) ;
50 ;
51 Q:$G(OCXWARN)
52 ;
53 S OCXWARN=1
54 ;
55 I $G(OCXAUTO) D Q
56 .D MESG(" Error... "_X)
57 .D MESG(" Error... File:"_(+$G(FILE)))
58 .D MESG(" Error... Index:"_(+$G(D0)))
59 .D MESG(" Error... Order Check Routine Compile Aborted.")
60 ;
61 S OCXWARN=$G(OCXWARN)+1
62 N OCXSP,OCXST,OCXTXT,OCXLEN,OCXZZZ,OCXCNT
63 S OCXLEN=60,OCXTXT="Compiler Warning # "_OCXWARN
64 I ($D(X)>2) S OCXCNT=0 F S OCXCNT=$O(X(OCXCNT)) Q:'OCXCNT D
65 .I ($L(X(OCXCNT))>OCXLEN),($L(X(OCXCNT))<80) S OCXLEN=$L(X(OCXCNT))
66 S (OCXSP,OCXST)="",$P(OCXST,"*",150)="*",$P(OCXSP," ",150)=" "
67 W !!
68 W !,$E(OCXST,1,OCXLEN+6)
69 W !,"**",$E(OCXSP,1,OCXLEN+2),"**"
70 W !,"** ",OCXTXT,$E(OCXSP,$L(OCXTXT),OCXLEN-1)," **"
71 W:$L($G(RLINE)) !,"** ",RLINE,$E(OCXSP,$L(RLINE),OCXLEN-1)," **"
72 W !,"**",$E(OCXSP,1,OCXLEN+2),"**"
73 S OCXGL="^OCXS" S:(FILE=1) OCXGL="^OCXD" S:(FILE=7) OCXGL="^OCXD" S:(FILE=10) OCXGL="^OCXD" S FILE=FILE/10+860
74 I $G(FILE),$G(D0),$D(@OCXGL@(FILE,D0,0)) D
75 .S OCXTXT=$P(@OCXGL@(FILE,0),U,1)
76 .W !,"** ",OCXTXT,$E(OCXSP,$L(OCXTXT),OCXLEN-1)," **"
77 .S OCXTXT=" "_$P(@OCXGL@(FILE,D0,0),U,1)
78 .W !,"** ",OCXTXT,$E(OCXSP,$L(OCXTXT),OCXLEN-1)," **"
79 W !,"**",$E(OCXSP,1,OCXLEN+2),"**"
80 I ($D(X)#2) D
81 .W !,"** " F OCXCNT=1:1:$L(X," ") D
82 ..I (($X+$L($P(X," ",OCXCNT)))>OCXLEN) W $E(OCXSP,$X,OCXLEN+2)," **",!,"** "
83 ..W $P(X," ",OCXCNT)," "
84 .W $E(OCXSP,$X,OCXLEN+2)," **"
85 I ($D(X)>2) S OCXCNT=0 F S OCXCNT=$O(X(OCXCNT)) Q:'OCXCNT D
86 .W !,"** ",X(OCXCNT),$E(OCXSP,$X,OCXLEN+2)," **"
87 W !,$E(OCXST,1,OCXLEN+6)
88 W !!!,"Press <Return> to continue... " R OCXZZZ:DTIME
89 Q
90 K D0
91 ;
92READ(OCXZ0,OCXZA,OCXZB,OCXZL) ;
93 N OCXLINE,DIR,DTOUT,DUOUT,DIRUT,DIROUT
94 Q:'$L($G(OCXZ0)) U
95 S DIR(0)=OCXZ0
96 S:$L($G(OCXZA)) DIR("A")=OCXZA
97 S:$L($G(OCXZB)) DIR("B")=OCXZB
98 F OCXLINE=1:1:($G(OCXZL)-1) W !
99 D ^DIR
100 I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) Q U
101 Q Y
102 ;
103 Q
104 ;
105DT(X,D) N Y,%DT S %DT=D D ^%DT Q Y
106 Q
107 ;
108CNT(X) ;
109 ;
110 N CNT,D0
111 S D0=0 F CNT=1:1 S D0=$O(@X@(D0)) Q:'D0
112 W !!,?10,X," ",CNT
113 Q CNT
114 ;
115AUTO ;
116 N OCXD0,OCXD1,OCXWARN,OCXNAM,OCXTRACE,OCXAUTO,OCXOETIM,OCXLCNT,OCXTSPI
117 S OCXWARN=0,OCXOETIM=$H
118 K ^TMP("OCXCMP",$J)
119 S ^TMP("OCXCMP",$J)=($P($H,",",2)+($H*86400)+(2*60*60))_" <- ^TMP ENTRY EXPIRATION DATE FOR ^OCXOPURG"
120 ;
121 ; Compiler Constants
122 ;
123 S OCXCLL=200 ; compiled code line length
124 S OCXCRS=8000 ; compiled routine size
125 S OCXTSPI=300 ; Duplicate triggered Rule message "ignore period" in seconds
126 ;
127 S OCXTRACE=0 ; Program Execution Trace Mode (OFF)
128 S OCXTLOG=0 ; Elapsed time logging (OFF)
129 S OCXDLOG=0 ; Raw Data Logging (OFF)
130 S OCXAUTO=1 ; Compile in the Background Mode (ON)
131 ;
132 D SETFLAG
133 L +^OCXD(861,1):5 E D ERMESG("Run aborted. Another compiler run has ^OCXD(861,1) locked."),BULL(DUZ),KILLFLAG Q
134 D RUN^OCXOCMP,BULL(DUZ),KILLFLAG
135 L -^OCXD(861,1)
136 ;
137 K ^TMP("OCXCMP",$J)
138 ;
139 Q
140 ;
141BULL(OCXDUZ) ;
142 I $L($T(^XMB)) D
143 .;
144 .N XMB,XMDUZ,XMY,OCXTIME
145 .S OCXTIME=$H-OCXOETIM*86400
146 .S OCXTIME=OCXTIME+($P($H,",",2)-$P(OCXOETIM,",",2))
147 .S XMB="OCX COMPILER RUN"
148 .S XMB(1)=$P($T(+3),";;",3)
149 .S XMB(2)=$$CONV($$DATE)
150 .S XMB(3)=""
151 .S:$G(OCXDUZ) XMB(3)="["_OCXDUZ_"] "_$P($G(^VA(200,OCXDUZ,0)),U,1)
152 .S XMB(4)=(OCXTIME\60)_" minutes "_(OCXTIME#60)_" seconds "
153 .S XMB(5)=$S(($G(OCXAUTO)>1):"Queued",$G(OCXAUTO):"Automatic Mode",1:"Interactive Mode")
154 .S XMB(6)=$S($G(OCXTRACE):" ON",1:"OFF")
155 .S XMB(7)=" " ; $S($G(OCXTLOG):" ON",1:"OFF")
156 .S XMB(8)=$S($G(OCXDLOG):(" ON Keep data for "_OCXDLOG_" day"_$S(OCXDLOG=1:"",1:"s")_" then purge."),1:"OFF")
157 .S XMB(9)=$S($G(OCXLCNT):OCXLCNT,1:"Zero")
158 .S XMB(10)=$G(OCXERRM)
159 .S XMB(11)=$S($L($G(OCXERRM)):"ABORTED",1:"has completed normally")
160 .S XMY("G.OCX DEVELOPERS@ISC-SLC.VA.GOV")=""
161 .S XMY("G.OCX DEVELOPERS")=""
162 .S XMY(OCXDUZ)=""
163 .S XMDUZ=.5
164 .S XMDT="N"
165 .D ^XMB
166 ;
167 Q
168 ;
169DATE() N X,Y,%DT S X="N",%DT="T" D ^%DT X ^DD("DD") Q Y
170 ;
171CONV(Y) Q:'(Y["@") Y Q $P(Y,"@",1)_" at "_$P(Y,"@",2,99)
172 ;
173SETFLAG ;
174 I '($P($G(^OCXD(861,1,0)),U,1)="SITE PREFERENCES") K ^OCXD(861,1) S ^OCXD(861,1,0)="SITE PREFERENCES"
175 S $P(^OCXD(861,1,0),U,3)=$H
176 Q
177 ;
178KILLFLAG ;
179 ;
180 I '($P($G(^OCXD(861,1,0)),U,1)="SITE PREFERENCES") K ^OCXD(861,1) S ^OCXD(861,1,0)="SITE PREFERENCES"
181 S $P(^OCXD(861,1,0),U,3)=""
182 Q
183 ;
184QUE(OCXADD) ;
185 ;
186 N ZTCPU,ZTDESC,ZTDTH,ZTIO,ZTPAR,ZTPRE,ZTPRI,ZTRTN,ZTSAVE,ZTSK,ZTUCI
187 N OCXDUZ
188 ;
189 S ZTDTH=$P($H,",",2)+OCXADD,OCXADD=0
190 I (ZTDTH>86400) S ZTDTH=(86400-ZTDTH),OCXADD=1
191 S ZTDTH=($H+OCXADD)_","_ZTDTH
192 S OCXDUZ=$G(DUZ)
193 S ZTIO="",ZTRTN="TASK^OCXOCMPV",ZTDESC="Queued Compiler: "_$P($T(+3),";;",2)
194 K ZTSAVE,ZTCPU,ZTUCI,ZTPRI,ZTPAR,ZTPRE
195 S ZTSAVE("OCXDUZ")=""
196 ;
197 D ^%ZTLOAD
198 ;
199 Q
200 ;
201TASK ;
202 ;
203 N OCXD0,OCXD1,OCXWARN,OCXNAM,OCXTRACE,OCXAUTO,OCXOETIM,OCXLCNT,OCXTSPI
204 S OCXWARN=0,OCXOETIM=$H
205 K ^TMP("OCXCMP",$J)
206 S ^TMP("OCXCMP",$J)=($P($H,",",2)+($H*86400)+(2*60*60))_" <- ^TMP ENTRY EXPIRATION DATE FOR ^OCXOPURG"
207 ;
208 ; Compiler Constants
209 ;
210 S OCXCLL=200 ; compiled code line length
211 S OCXCRS=8000 ; compiled routine size
212 S OCXTSPI=300 ; Duplicate triggered Rule message "ignore period" in seconds
213 ;
214 S OCXDATA="0^0^0"
215 I $L($T(CDATA^OCXOZ01)) S OCXDATA=$$CDATA^OCXOZ01
216 ;
217 S OCXTRACE=$P(OCXDATA,U,1),OCXTLOG=$P(OCXDATA,U,2),OCXDLOG=$P(OCXDATA,U,3)
218 ;
219 S OCXAUTO=2 ; Compile in the Background Mode (ON QUEUED)
220 ;
221 D SETFLAG
222 L +^OCXD(861,1):5 E D QUE^OCXOCMPV(300),ERMESG("Run rescheduled. Another compiler run has ^OCXD(861,1) locked."),BULL(OCXDUZ),KILLFLAG Q
223 D RUN^OCXOCMP,BULL(OCXDUZ),KILLFLAG
224 L -^OCXD(861,1)
225 ;
226 K ^TMP("OCXCMP",$J)
227 ;
228 I $G(ZTSK) D KILL^%ZTLOAD
229 ;
230 Q
231 ;
Note: See TracBrowser for help on using the repository browser.