- OCXOCMPV ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Main Entry point - All Rules cont...) ;1/05/04 14:09
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,105,221,243**;Dec 17,1997;Build 242
- ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
- ;
- MAN ;
- I '$D(DUZ) W !!,"DUZ not defined." Q
- N OCXD0,OCXD1,OCXWARN,OCXNAM,OCXTRACE,OCXOETIM,OCXAUTO,OCXERRM,OCXTSPI
- S OCXWARN=0,OCXOETIM=$H
- K ^TMP("OCXCMP",$J)
- S ^TMP("OCXCMP",$J)=($P($H,",",2)+($H*86400)+(2*60*60))_" <- ^TMP ENTRY EXPIRATION DATE FOR ^OCXOPURG"
- ;
- ; Compiler Constants
- ;
- S OCXCLL=200 ; compiled code line length
- S OCXCRS=4000 ; compiled routine size
- S OCXTSPI=300 ; Duplicate triggered Rule message "ignore period" in seconds
- ;
- S OCXTRACE=0,OCXTLOG=0,OCXDLOG=0,OCXAUTO=0,OCXERRM=""
- ;
- S OCXTRACE=$$READ("Y","Want to enable Compiled Routine Execution Display ","NO") Q:(OCXTRACE[U)
- S OCXDLOG=$$READ("Y","Want to enable Logging of incoming raw data ","NO") Q:(OCXDLOG[U)
- I OCXDLOG S OCXDLOG=$$READ("N^1:20","Number of days to keep raw data ","3") Q:(OCXDLOG[U)
- I OCXDLOG W !!,"*** Note: The raw data log will only hold 200,000 entries. *****",!
- I 0 I OCXDLOG S OCXTLOG=$$READ("Y","Want to enable Elapsed Time Logging ","YES") Q:(OCXTLOG[U)
- ;
- Q:'$$READ("Y","Are you sure you want to recompile the Expert System routines ","NO")
- ;
- D SETFLAG
- L +^OCXD(861,1):5 E D ERMESG("Run aborted. Another compiler run has ^OCXD(861,1) locked.") Q
- D RUN^OCXOCMP,BULL(DUZ),KILLFLAG
- L -^OCXD(861,1)
- ;
- ;K ^TMP("OCXCMP",$J)
- ;
- Q
- ;
- MESG(OCXX) ;
- I '$G(OCXAUTO) W !!,OCXX
- I ($G(OCXAUTO)=1) D BMES^XPDUTL(.OCXX)
- Q
- ;
- ERMESG(OCXX) ;
- N OCXY S OCXY=OCXX
- I '$G(OCXAUTO) W !!,OCXX
- I ($G(OCXAUTO)=1) D BMES^XPDUTL(.OCXX)
- S OCXERRM=OCXY
- Q
- ;
- WARN(X,FILE,D0,RLINE) ;
- ;
- Q:$G(OCXWARN)
- ;
- S OCXWARN=1
- ;
- I $G(OCXAUTO) D Q
- .D MESG(" Error... "_X)
- .D MESG(" Error... File:"_(+$G(FILE)))
- .D MESG(" Error... Index:"_(+$G(D0)))
- .D MESG(" Error... Order Check Routine Compile Aborted.")
- ;
- S OCXWARN=$G(OCXWARN)+1
- N OCXSP,OCXST,OCXTXT,OCXLEN,OCXZZZ,OCXCNT
- S OCXLEN=60,OCXTXT="Compiler Warning # "_OCXWARN
- I ($D(X)>2) S OCXCNT=0 F S OCXCNT=$O(X(OCXCNT)) Q:'OCXCNT D
- .I ($L(X(OCXCNT))>OCXLEN),($L(X(OCXCNT))<80) S OCXLEN=$L(X(OCXCNT))
- S (OCXSP,OCXST)="",$P(OCXST,"*",150)="*",$P(OCXSP," ",150)=" "
- W !!
- W !,$E(OCXST,1,OCXLEN+6)
- W !,"**",$E(OCXSP,1,OCXLEN+2),"**"
- W !,"** ",OCXTXT,$E(OCXSP,$L(OCXTXT),OCXLEN-1)," **"
- W:$L($G(RLINE)) !,"** ",RLINE,$E(OCXSP,$L(RLINE),OCXLEN-1)," **"
- W !,"**",$E(OCXSP,1,OCXLEN+2),"**"
- S OCXGL="^OCXS" S:(FILE=1) OCXGL="^OCXD" S:(FILE=7) OCXGL="^OCXD" S:(FILE=10) OCXGL="^OCXD" S FILE=FILE/10+860
- I $G(FILE),$G(D0),$D(@OCXGL@(FILE,D0,0)) D
- .S OCXTXT=$P(@OCXGL@(FILE,0),U,1)
- .W !,"** ",OCXTXT,$E(OCXSP,$L(OCXTXT),OCXLEN-1)," **"
- .S OCXTXT=" "_$P(@OCXGL@(FILE,D0,0),U,1)
- .W !,"** ",OCXTXT,$E(OCXSP,$L(OCXTXT),OCXLEN-1)," **"
- W !,"**",$E(OCXSP,1,OCXLEN+2),"**"
- I ($D(X)#2) D
- .W !,"** " F OCXCNT=1:1:$L(X," ") D
- ..I (($X+$L($P(X," ",OCXCNT)))>OCXLEN) W $E(OCXSP,$X,OCXLEN+2)," **",!,"** "
- ..W $P(X," ",OCXCNT)," "
- .W $E(OCXSP,$X,OCXLEN+2)," **"
- I ($D(X)>2) S OCXCNT=0 F S OCXCNT=$O(X(OCXCNT)) Q:'OCXCNT D
- .W !,"** ",X(OCXCNT),$E(OCXSP,$X,OCXLEN+2)," **"
- W !,$E(OCXST,1,OCXLEN+6)
- W !!!,"Press <Return> to continue... " R OCXZZZ:DTIME
- Q
- K D0
- ;
- READ(OCXZ0,OCXZA,OCXZB,OCXZL) ;
- N OCXLINE,DIR,DTOUT,DUOUT,DIRUT,DIROUT
- Q:'$L($G(OCXZ0)) U
- S DIR(0)=OCXZ0
- S:$L($G(OCXZA)) DIR("A")=OCXZA
- S:$L($G(OCXZB)) DIR("B")=OCXZB
- F OCXLINE=1:1:($G(OCXZL)-1) W !
- D ^DIR
- I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) Q U
- Q Y
- ;
- Q
- ;
- DT(X,D) N Y,%DT S %DT=D D ^%DT Q Y
- Q
- ;
- CNT(X) ;
- ;
- N CNT,D0
- S D0=0 F CNT=1:1 S D0=$O(@X@(D0)) Q:'D0
- W !!,?10,X," ",CNT
- Q CNT
- ;
- AUTO ;
- N OCXD0,OCXD1,OCXWARN,OCXNAM,OCXTRACE,OCXAUTO,OCXOETIM,OCXTSPI
- S OCXWARN=0,OCXOETIM=$H
- K ^TMP("OCXCMP",$J)
- S ^TMP("OCXCMP",$J)=($P($H,",",2)+($H*86400)+(2*60*60))_" <- ^TMP ENTRY EXPIRATION DATE FOR ^OCXOPURG"
- ;
- ; Compiler Constants
- ;
- S OCXCLL=200 ; compiled code line length
- S OCXCRS=8000 ; compiled routine size
- S OCXTSPI=300 ; Duplicate triggered Rule message "ignore period" in seconds
- ;
- S OCXTRACE=0 ; Program Execution Trace Mode (OFF)
- S OCXTLOG=0 ; Elapsed time logging (OFF)
- S OCXDLOG=0 ; Raw Data Logging (OFF)
- S OCXAUTO=1 ; Compile in the Background Mode (ON)
- ;
- D SETFLAG
- L +^OCXD(861,1):5 E D ERMESG("Run aborted. Another compiler run has ^OCXD(861,1) locked."),BULL(DUZ),KILLFLAG Q
- D RUN^OCXOCMP,BULL(DUZ),KILLFLAG
- L -^OCXD(861,1)
- ;
- K ^TMP("OCXCMP",$J)
- ;
- Q
- ;
- BULL(OCXDUZ) ;
- I $L($T(^XMB)) D
- .;
- .N XMB,XMDUZ,XMY,OCXTIME
- .S OCXTIME=$H-OCXOETIM*86400
- .S OCXTIME=OCXTIME+($P($H,",",2)-$P(OCXOETIM,",",2))
- .S XMB="OCX COMPILER RUN"
- .S XMB(1)=$P($T(+3),";;",3)
- .S XMB(2)=$$CONV($$DATE)
- .S XMB(3)=""
- .S:$G(OCXDUZ) XMB(3)="["_OCXDUZ_"] "_$P($G(^VA(200,OCXDUZ,0)),U,1)
- .S XMB(4)=(OCXTIME\60)_" minutes "_(OCXTIME#60)_" seconds "
- .S XMB(5)=$S(($G(OCXAUTO)>1):"Queued",$G(OCXAUTO):"Automatic Mode",1:"Interactive Mode")
- .S XMB(6)=$S($G(OCXTRACE):" ON",1:"OFF")
- .S XMB(7)=" " ; $S($G(OCXTLOG):" ON",1:"OFF")
- .S XMB(8)=$S($G(OCXDLOG):(" ON Keep data for "_OCXDLOG_" day"_$S(OCXDLOG=1:"",1:"s")_" then purge."),1:"OFF")
- .S XMB(9)="No longer tracked" ; $S($G(OCXLCNT):OCXLCNT,1:"Zero")
- .S XMB(10)=$G(OCXERRM)
- .S XMB(11)=$S($L($G(OCXERRM)):"ABORTED",1:"has completed normally")
- .S XMY("G.OCX DEVELOPERS@ISC-SLC.DOMAIN.EXT")=""
- .S XMY("G.OCX DEVELOPERS")=""
- .S XMY(OCXDUZ)=""
- .S XMDUZ=.5
- .S XMDT="N"
- .D ^XMB
- ;
- Q
- ;
- DATE() N X,Y,%DT S X="N",%DT="T" D ^%DT X ^DD("DD") Q Y
- ;
- CONV(Y) Q:'(Y["@") Y Q $P(Y,"@",1)_" at "_$P(Y,"@",2,99)
- ;
- SETFLAG ;
- I '($P($G(^OCXD(861,1,0)),U,1)="SITE PREFERENCES") K ^OCXD(861,1) S ^OCXD(861,1,0)="SITE PREFERENCES"
- S $P(^OCXD(861,1,0),U,3)=$H
- Q
- ;
- KILLFLAG ;
- ;
- I '($P($G(^OCXD(861,1,0)),U,1)="SITE PREFERENCES") K ^OCXD(861,1) S ^OCXD(861,1,0)="SITE PREFERENCES"
- S $P(^OCXD(861,1,0),U,3)=""
- Q
- ;
- QUE(OCXADD) ;
- ;
- N ZTCPU,ZTDESC,ZTDTH,ZTIO,ZTPAR,ZTPRE,ZTPRI,ZTRTN,ZTSAVE,ZTSK,ZTUCI
- N OCXDUZ
- ;
- S ZTDTH=$P($H,",",2)+OCXADD,OCXADD=0
- I (ZTDTH>86400) S ZTDTH=(86400-ZTDTH),OCXADD=1
- S ZTDTH=($H+OCXADD)_","_ZTDTH
- S OCXDUZ=$G(DUZ)
- S ZTIO="",ZTRTN="TASK^OCXOCMPV",ZTDESC="Queued Compiler: "_$P($T(+3),";;",2)
- K ZTSAVE,ZTCPU,ZTUCI,ZTPRI,ZTPAR,ZTPRE
- S ZTSAVE("OCXDUZ")=""
- ;
- D ^%ZTLOAD
- ;
- Q
- ;
- TASK ;
- ;
- N OCXD0,OCXD1,OCXWARN,OCXNAM,OCXTRACE,OCXAUTO,OCXOETIM,OCXTSPI
- S OCXWARN=0,OCXOETIM=$H
- K ^TMP("OCXCMP",$J)
- S ^TMP("OCXCMP",$J)=($P($H,",",2)+($H*86400)+(2*60*60))_" <- ^TMP ENTRY EXPIRATION DATE FOR ^OCXOPURG"
- ;
- ; Compiler Constants
- ;
- S OCXCLL=200 ; compiled code line length
- S OCXCRS=8000 ; compiled routine size
- S OCXTSPI=300 ; Duplicate triggered Rule message "ignore period" in seconds
- ;
- S OCXDATA="0^0^0"
- I $L($T(CDATA^OCXOZ01)) S OCXDATA=$$CDATA^OCXOZ01
- ;
- S OCXTRACE=$P(OCXDATA,U,1),OCXTLOG=$P(OCXDATA,U,2),OCXDLOG=$P(OCXDATA,U,3)
- ;
- S OCXAUTO=2 ; Compile in the Background Mode (ON QUEUED)
- ;
- D SETFLAG
- 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
- D RUN^OCXOCMP,BULL(OCXDUZ),KILLFLAG
- L -^OCXD(861,1)
- ;
- K ^TMP("OCXCMP",$J)
- ;
- I $G(ZTSK) D KILL^%ZTLOAD
- ;
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOCXOCMPV 7464 printed Jan 18, 2025@03:26:17 Page 2
- OCXOCMPV ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Main Entry point - All Rules cont...) ;1/05/04 14:09
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,105,221,243**;Dec 17,1997;Build 242
- +2 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
- +3 ;
- MAN ;
- +1 IF '$DATA(DUZ)
- WRITE !!,"DUZ not defined."
- QUIT
- +2 NEW OCXD0,OCXD1,OCXWARN,OCXNAM,OCXTRACE,OCXOETIM,OCXAUTO,OCXERRM,OCXTSPI
- +3 SET OCXWARN=0
- SET OCXOETIM=$HOROLOG
- +4 KILL ^TMP("OCXCMP",$JOB)
- +5 SET ^TMP("OCXCMP",$JOB)=($PIECE($HOROLOG,",",2)+($HOROLOG*86400)+(2*60*60))_" <- ^TMP ENTRY EXPIRATION DATE FOR ^OCXOPURG"
- +6 ;
- +7 ; Compiler Constants
- +8 ;
- +9 ; compiled code line length
- SET OCXCLL=200
- +10 ; compiled routine size
- SET OCXCRS=4000
- +11 ; Duplicate triggered Rule message "ignore period" in seconds
- SET OCXTSPI=300
- +12 ;
- +13 SET OCXTRACE=0
- SET OCXTLOG=0
- SET OCXDLOG=0
- SET OCXAUTO=0
- SET OCXERRM=""
- +14 ;
- +15 SET OCXTRACE=$$READ("Y","Want to enable Compiled Routine Execution Display ","NO")
- if (OCXTRACE[U)
- QUIT
- +16 SET OCXDLOG=$$READ("Y","Want to enable Logging of incoming raw data ","NO")
- if (OCXDLOG[U)
- QUIT
- +17 IF OCXDLOG
- SET OCXDLOG=$$READ("N^1:20","Number of days to keep raw data ","3")
- if (OCXDLOG[U)
- QUIT
- +18 IF OCXDLOG
- WRITE !!,"*** Note: The raw data log will only hold 200,000 entries. *****",!
- +19 IF 0
- IF OCXDLOG
- SET OCXTLOG=$$READ("Y","Want to enable Elapsed Time Logging ","YES")
- if (OCXTLOG[U)
- QUIT
- +20 ;
- +21 if '$$READ("Y","Are you sure you want to recompile the Expert System routines ","NO")
- QUIT
- +22 ;
- +23 DO SETFLAG
- +24 LOCK +^OCXD(861,1):5
- IF '$TEST
- DO ERMESG("Run aborted. Another compiler run has ^OCXD(861,1) locked.")
- QUIT
- +25 DO RUN^OCXOCMP
- DO BULL(DUZ)
- DO KILLFLAG
- +26 LOCK -^OCXD(861,1)
- +27 ;
- +28 ;K ^TMP("OCXCMP",$J)
- +29 ;
- +30 QUIT
- +31 ;
- MESG(OCXX) ;
- +1 IF '$GET(OCXAUTO)
- WRITE !!,OCXX
- +2 IF ($GET(OCXAUTO)=1)
- DO BMES^XPDUTL(.OCXX)
- +3 QUIT
- +4 ;
- ERMESG(OCXX) ;
- +1 NEW OCXY
- SET OCXY=OCXX
- +2 IF '$GET(OCXAUTO)
- WRITE !!,OCXX
- +3 IF ($GET(OCXAUTO)=1)
- DO BMES^XPDUTL(.OCXX)
- +4 SET OCXERRM=OCXY
- +5 QUIT
- +6 ;
- WARN(X,FILE,D0,RLINE) ;
- +1 ;
- +2 if $GET(OCXWARN)
- QUIT
- +3 ;
- +4 SET OCXWARN=1
- +5 ;
- +6 IF $GET(OCXAUTO)
- Begin DoDot:1
- +7 DO MESG(" Error... "_X)
- +8 DO MESG(" Error... File:"_(+$GET(FILE)))
- +9 DO MESG(" Error... Index:"_(+$GET(D0)))
- +10 DO MESG(" Error... Order Check Routine Compile Aborted.")
- End DoDot:1
- QUIT
- +11 ;
- +12 SET OCXWARN=$GET(OCXWARN)+1
- +13 NEW OCXSP,OCXST,OCXTXT,OCXLEN,OCXZZZ,OCXCNT
- +14 SET OCXLEN=60
- SET OCXTXT="Compiler Warning # "_OCXWARN
- +15 IF ($DATA(X)>2)
- SET OCXCNT=0
- FOR
- SET OCXCNT=$ORDER(X(OCXCNT))
- if 'OCXCNT
- QUIT
- Begin DoDot:1
- +16 IF ($LENGTH(X(OCXCNT))>OCXLEN)
- IF ($LENGTH(X(OCXCNT))<80)
- SET OCXLEN=$LENGTH(X(OCXCNT))
- End DoDot:1
- +17 SET (OCXSP,OCXST)=""
- SET $PIECE(OCXST,"*",150)="*"
- SET $PIECE(OCXSP," ",150)=" "
- +18 WRITE !!
- +19 WRITE !,$EXTRACT(OCXST,1,OCXLEN+6)
- +20 WRITE !,"**",$EXTRACT(OCXSP,1,OCXLEN+2),"**"
- +21 WRITE !,"** ",OCXTXT,$EXTRACT(OCXSP,$LENGTH(OCXTXT),OCXLEN-1)," **"
- +22 if $LENGTH($GET(RLINE))
- WRITE !,"** ",RLINE,$EXTRACT(OCXSP,$LENGTH(RLINE),OCXLEN-1)," **"
- +23 WRITE !,"**",$EXTRACT(OCXSP,1,OCXLEN+2),"**"
- +24 SET OCXGL="^OCXS"
- if (FILE=1)
- SET OCXGL="^OCXD"
- if (FILE=7)
- SET OCXGL="^OCXD"
- if (FILE=10)
- SET OCXGL="^OCXD"
- SET FILE=FILE/10+860
- +25 IF $GET(FILE)
- IF $GET(D0)
- IF $DATA(@OCXGL@(FILE,D0,0))
- Begin DoDot:1
- +26 SET OCXTXT=$PIECE(@OCXGL@(FILE,0),U,1)
- +27 WRITE !,"** ",OCXTXT,$EXTRACT(OCXSP,$LENGTH(OCXTXT),OCXLEN-1)," **"
- +28 SET OCXTXT=" "_$PIECE(@OCXGL@(FILE,D0,0),U,1)
- +29 WRITE !,"** ",OCXTXT,$EXTRACT(OCXSP,$LENGTH(OCXTXT),OCXLEN-1)," **"
- End DoDot:1
- +30 WRITE !,"**",$EXTRACT(OCXSP,1,OCXLEN+2),"**"
- +31 IF ($DATA(X)#2)
- Begin DoDot:1
- +32 WRITE !,"** "
- FOR OCXCNT=1:1:$LENGTH(X," ")
- Begin DoDot:2
- +33 IF (($X+$LENGTH($PIECE(X," ",OCXCNT)))>OCXLEN)
- WRITE $EXTRACT(OCXSP,$X,OCXLEN+2)," **",!,"** "
- +34 WRITE $PIECE(X," ",OCXCNT)," "
- End DoDot:2
- +35 WRITE $EXTRACT(OCXSP,$X,OCXLEN+2)," **"
- End DoDot:1
- +36 IF ($DATA(X)>2)
- SET OCXCNT=0
- FOR
- SET OCXCNT=$ORDER(X(OCXCNT))
- if 'OCXCNT
- QUIT
- Begin DoDot:1
- +37 WRITE !,"** ",X(OCXCNT),$EXTRACT(OCXSP,$X,OCXLEN+2)," **"
- End DoDot:1
- +38 WRITE !,$EXTRACT(OCXST,1,OCXLEN+6)
- +39 WRITE !!!,"Press <Return> to continue... "
- READ OCXZZZ:DTIME
- +40 QUIT
- +41 KILL D0
- +42 ;
- READ(OCXZ0,OCXZA,OCXZB,OCXZL) ;
- +1 NEW OCXLINE,DIR,DTOUT,DUOUT,DIRUT,DIROUT
- +2 if '$LENGTH($GET(OCXZ0))
- QUIT U
- +3 SET DIR(0)=OCXZ0
- +4 if $LENGTH($GET(OCXZA))
- SET DIR("A")=OCXZA
- +5 if $LENGTH($GET(OCXZB))
- SET DIR("B")=OCXZB
- +6 FOR OCXLINE=1:1:($GET(OCXZL)-1)
- WRITE !
- +7 DO ^DIR
- +8 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
- QUIT U
- +9 QUIT Y
- +10 ;
- +11 QUIT
- +12 ;
- DT(X,D) NEW Y,%DT
- SET %DT=D
- DO ^%DT
- QUIT Y
- +1 QUIT
- +2 ;
- CNT(X) ;
- +1 ;
- +2 NEW CNT,D0
- +3 SET D0=0
- FOR CNT=1:1
- SET D0=$ORDER(@X@(D0))
- if 'D0
- QUIT
- +4 WRITE !!,?10,X," ",CNT
- +5 QUIT CNT
- +6 ;
- AUTO ;
- +1 NEW OCXD0,OCXD1,OCXWARN,OCXNAM,OCXTRACE,OCXAUTO,OCXOETIM,OCXTSPI
- +2 SET OCXWARN=0
- SET OCXOETIM=$HOROLOG
- +3 KILL ^TMP("OCXCMP",$JOB)
- +4 SET ^TMP("OCXCMP",$JOB)=($PIECE($HOROLOG,",",2)+($HOROLOG*86400)+(2*60*60))_" <- ^TMP ENTRY EXPIRATION DATE FOR ^OCXOPURG"
- +5 ;
- +6 ; Compiler Constants
- +7 ;
- +8 ; compiled code line length
- SET OCXCLL=200
- +9 ; compiled routine size
- SET OCXCRS=8000
- +10 ; Duplicate triggered Rule message "ignore period" in seconds
- SET OCXTSPI=300
- +11 ;
- +12 ; Program Execution Trace Mode (OFF)
- SET OCXTRACE=0
- +13 ; Elapsed time logging (OFF)
- SET OCXTLOG=0
- +14 ; Raw Data Logging (OFF)
- SET OCXDLOG=0
- +15 ; Compile in the Background Mode (ON)
- SET OCXAUTO=1
- +16 ;
- +17 DO SETFLAG
- +18 LOCK +^OCXD(861,1):5
- IF '$TEST
- DO ERMESG("Run aborted. Another compiler run has ^OCXD(861,1) locked.")
- DO BULL(DUZ)
- DO KILLFLAG
- QUIT
- +19 DO RUN^OCXOCMP
- DO BULL(DUZ)
- DO KILLFLAG
- +20 LOCK -^OCXD(861,1)
- +21 ;
- +22 KILL ^TMP("OCXCMP",$JOB)
- +23 ;
- +24 QUIT
- +25 ;
- BULL(OCXDUZ) ;
- +1 IF $LENGTH($TEXT(^XMB))
- Begin DoDot:1
- +2 ;
- +3 NEW XMB,XMDUZ,XMY,OCXTIME
- +4 SET OCXTIME=$HOROLOG-OCXOETIM*86400
- +5 SET OCXTIME=OCXTIME+($PIECE($HOROLOG,",",2)-$PIECE(OCXOETIM,",",2))
- +6 SET XMB="OCX COMPILER RUN"
- +7 SET XMB(1)=$PIECE($TEXT(+3),";;",3)
- +8 SET XMB(2)=$$CONV($$DATE)
- +9 SET XMB(3)=""
- +10 if $GET(OCXDUZ)
- SET XMB(3)="["_OCXDUZ_"] "_$PIECE($GET(^VA(200,OCXDUZ,0)),U,1)
- +11 SET XMB(4)=(OCXTIME\60)_" minutes "_(OCXTIME#60)_" seconds "
- +12 SET XMB(5)=$SELECT(($GET(OCXAUTO)>1):"Queued",$GET(OCXAUTO):"Automatic Mode",1:"Interactive Mode")
- +13 SET XMB(6)=$SELECT($GET(OCXTRACE):" ON",1:"OFF")
- +14 ; $S($G(OCXTLOG):" ON",1:"OFF")
- SET XMB(7)=" "
- +15 SET XMB(8)=$SELECT($GET(OCXDLOG):(" ON Keep data for "_OCXDLOG_" day"_$SELECT(OCXDLOG=1:"",1:"s")_" then purge."),1:"OFF")
- +16 ; $S($G(OCXLCNT):OCXLCNT,1:"Zero")
- SET XMB(9)="No longer tracked"
- +17 SET XMB(10)=$GET(OCXERRM)
- +18 SET XMB(11)=$SELECT($LENGTH($GET(OCXERRM)):"ABORTED",1:"has completed normally")
- +19 SET XMY("G.OCX DEVELOPERS@ISC-SLC.DOMAIN.EXT")=""
- +20 SET XMY("G.OCX DEVELOPERS")=""
- +21 SET XMY(OCXDUZ)=""
- +22 SET XMDUZ=.5
- +23 SET XMDT="N"
- +24 DO ^XMB
- End DoDot:1
- +25 ;
- +26 QUIT
- +27 ;
- DATE() NEW X,Y,%DT
- SET X="N"
- SET %DT="T"
- DO ^%DT
- XECUTE ^DD("DD")
- QUIT Y
- +1 ;
- CONV(Y) if '(Y["@")
- QUIT Y
- QUIT $PIECE(Y,"@",1)_" at "_$PIECE(Y,"@",2,99)
- +1 ;
- SETFLAG ;
- +1 IF '($PIECE($GET(^OCXD(861,1,0)),U,1)="SITE PREFERENCES")
- KILL ^OCXD(861,1)
- SET ^OCXD(861,1,0)="SITE PREFERENCES"
- +2 SET $PIECE(^OCXD(861,1,0),U,3)=$HOROLOG
- +3 QUIT
- +4 ;
- KILLFLAG ;
- +1 ;
- +2 IF '($PIECE($GET(^OCXD(861,1,0)),U,1)="SITE PREFERENCES")
- KILL ^OCXD(861,1)
- SET ^OCXD(861,1,0)="SITE PREFERENCES"
- +3 SET $PIECE(^OCXD(861,1,0),U,3)=""
- +4 QUIT
- +5 ;
- QUE(OCXADD) ;
- +1 ;
- +2 NEW ZTCPU,ZTDESC,ZTDTH,ZTIO,ZTPAR,ZTPRE,ZTPRI,ZTRTN,ZTSAVE,ZTSK,ZTUCI
- +3 NEW OCXDUZ
- +4 ;
- +5 SET ZTDTH=$PIECE($HOROLOG,",",2)+OCXADD
- SET OCXADD=0
- +6 IF (ZTDTH>86400)
- SET ZTDTH=(86400-ZTDTH)
- SET OCXADD=1
- +7 SET ZTDTH=($HOROLOG+OCXADD)_","_ZTDTH
- +8 SET OCXDUZ=$GET(DUZ)
- +9 SET ZTIO=""
- SET ZTRTN="TASK^OCXOCMPV"
- SET ZTDESC="Queued Compiler: "_$PIECE($TEXT(+3),";;",2)
- +10 KILL ZTSAVE,ZTCPU,ZTUCI,ZTPRI,ZTPAR,ZTPRE
- +11 SET ZTSAVE("OCXDUZ")=""
- +12 ;
- +13 DO ^%ZTLOAD
- +14 ;
- +15 QUIT
- +16 ;
- TASK ;
- +1 ;
- +2 NEW OCXD0,OCXD1,OCXWARN,OCXNAM,OCXTRACE,OCXAUTO,OCXOETIM,OCXTSPI
- +3 SET OCXWARN=0
- SET OCXOETIM=$HOROLOG
- +4 KILL ^TMP("OCXCMP",$JOB)
- +5 SET ^TMP("OCXCMP",$JOB)=($PIECE($HOROLOG,",",2)+($HOROLOG*86400)+(2*60*60))_" <- ^TMP ENTRY EXPIRATION DATE FOR ^OCXOPURG"
- +6 ;
- +7 ; Compiler Constants
- +8 ;
- +9 ; compiled code line length
- SET OCXCLL=200
- +10 ; compiled routine size
- SET OCXCRS=8000
- +11 ; Duplicate triggered Rule message "ignore period" in seconds
- SET OCXTSPI=300
- +12 ;
- +13 SET OCXDATA="0^0^0"
- +14 IF $LENGTH($TEXT(CDATA^OCXOZ01))
- SET OCXDATA=$$CDATA^OCXOZ01
- +15 ;
- +16 SET OCXTRACE=$PIECE(OCXDATA,U,1)
- SET OCXTLOG=$PIECE(OCXDATA,U,2)
- SET OCXDLOG=$PIECE(OCXDATA,U,3)
- +17 ;
- +18 ; Compile in the Background Mode (ON QUEUED)
- SET OCXAUTO=2
- +19 ;
- +20 DO SETFLAG
- +21 LOCK +^OCXD(861,1):5
- IF '$TEST
- DO QUE^OCXOCMPV(300)
- DO ERMESG("Run rescheduled. Another compiler run has ^OCXD(861,1) locked.")
- DO BULL(OCXDUZ)
- DO KILLFLAG
- QUIT
- +22 DO RUN^OCXOCMP
- DO BULL(OCXDUZ)
- DO KILLFLAG
- +23 LOCK -^OCXD(861,1)
- +24 ;
- +25 KILL ^TMP("OCXCMP",$JOB)
- +26 ;
- +27 IF $GET(ZTSK)
- DO KILL^%ZTLOAD
- +28 ;
- +29 QUIT
- +30 ;