- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXOCMPV.m
r613 r623 1 OCXOCMPV 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,105,221,243**;Dec 17,1997;Build 242 3 4 5 MAN 6 7 N OCXD0,OCXD1,OCXWARN,OCXNAM,OCXTRACE,OCXOETIM,OCXAUTO,OCXERRM,OCXTSPI8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 MESG(OCXX) 38 39 40 41 42 ERMESG(OCXX) 43 44 45 46 47 48 49 WARN(X,FILE,D0,RLINE) 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 READ(OCXZ0,OCXZA,OCXZB,OCXZL) 93 94 95 96 97 98 99 100 101 102 103 104 105 DT(X,D) 106 107 108 CNT(X) 109 110 111 112 113 114 115 AUTO 116 N OCXD0,OCXD1,OCXWARN,OCXNAM,OCXTRACE,OCXAUTO,OCXOETIM,OCXTSPI117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 BULL(OCXDUZ) 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 .S XMB(9)="No longer tracked" ;$S($G(OCXLCNT):OCXLCNT,1:"Zero")158 159 160 161 162 163 164 165 166 167 168 169 DATE() 170 171 CONV(Y) 172 173 SETFLAG 174 175 176 177 178 KILLFLAG 179 180 181 182 183 184 QUE(OCXADD) 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 TASK 202 203 N OCXD0,OCXD1,OCXWARN,OCXNAM,OCXTRACE,OCXAUTO,OCXOETIM,OCXTSPI204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 1 OCXOCMPV ;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 ; 5 MAN ; 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 ; 37 MESG(OCXX) ; 38 I '$G(OCXAUTO) W !!,OCXX 39 I ($G(OCXAUTO)=1) D BMES^XPDUTL(.OCXX) 40 Q 41 ; 42 ERMESG(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 ; 49 WARN(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 ; 92 READ(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 ; 105 DT(X,D) N Y,%DT S %DT=D D ^%DT Q Y 106 Q 107 ; 108 CNT(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 ; 115 AUTO ; 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 ; 141 BULL(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 ; 169 DATE() N X,Y,%DT S X="N",%DT="T" D ^%DT X ^DD("DD") Q Y 170 ; 171 CONV(Y) Q:'(Y["@") Y Q $P(Y,"@",1)_" at "_$P(Y,"@",2,99) 172 ; 173 SETFLAG ; 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 ; 178 KILLFLAG ; 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 ; 184 QUE(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 ; 201 TASK ; 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 TracChangeset
for help on using the changeset viewer.
