[623] | 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 | ;
|
---|