OCXOCMP6 ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Assemble Order Check Routines) ;1/05/04 14:33
;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,221,243**;Dec 17,1997;Build 242
;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
;
EN() ;
;
Q:$G(OCXWARN) 1
N OCXD0,OCXD1,OCXRN,OCXSCNT,OCXOFF
;
W:'$G(OCXAUTO) !,?5,"Generate Extrinsic Function and Variables documentation..."
S OCXD0=0 F S OCXD0=$O(^TMP("OCXCMP",$J,"C CODE",OCXD0)) Q:'OCXD0 D DOC^OCXOCMPT(OCXD0)
;
K ^OCXS(860.3,"APGM")
S OCXD0=0 F S OCXD0=$O(^OCXS(860.3,OCXD0)) Q:'OCXD0 D
.K ^OCXS(860.3,OCXD0,"RTN") I '$G(OCXAUTO) W:($X>60) ! W "."
;
K ^TMP("OCXCMP",$J,"D CODE")
;
W:'$G(OCXAUTO) !,?5,"Assign Subroutines to Routines..."
S OCXRN=1,OCXD0=0
D GETHDR(1)
F S OCXD0=$O(^TMP("OCXCMP",$J,"C CODE",OCXD0)) Q:'OCXD0 D Q:OCXWARN
.N OCXLLAB,OCXSKIP,OCXEXF,OCXSUB,OCXSIZE,OCXFILE,OCXCCODE,OCXDCODE,OCXLAST
.I '$G(OCXAUTO) W:($X>60) ! W "."
.S OCXLLAB=^TMP("OCXCMP",$J,"LINE",OCXD0)
.S OCXSKIP=((OCXLLAB="UPDATE")!(OCXLLAB="LOG"))
.S OCXSIZE=$$SIZE^OCXOCMP8(OCXRN,OCXD0)
.S OCXLAST='$O(^TMP("OCXCMP",$J,"C CODE",OCXD0))
.S OCXFILE=(OCXSIZE>OCXCRS)!(OCXLAST) S:OCXSKIP OCXFILE=0
.I OCXFILE D
..K OCXEXF S OCXEXF=""
..I $D(^TMP("OCXCMP",$J,"D CODE",OCXRN,"CALLS")) M OCXEXF=^("CALLS")
..S OCXSUB="" F S OCXSUB=$O(OCXEXF(OCXSUB)) Q:'$L(OCXSUB) I 'OCXEXF(OCXSUB) D
...S OCXEXF(OCXSUB)=1,OCXEXF=OCXSUB
...S OCXSUB="" F S OCXSUB=$O(^TMP("OCXCMP",$J,"INCLUDE",OCXEXF,"CALLS",OCXSUB)) Q:'$L(OCXSUB) D
....S OCXEXF(OCXSUB)=$G(OCXEXF(OCXSUB))
..S OCXSUB="" F S OCXSUB=$O(OCXEXF(OCXSUB)) Q:'$L(OCXSUB) D
...D APPEND^OCXOCMP8(OCXRN,OCXSUB,"F")
..D APPEND^OCXOCMP8(OCXRN,"$")
..S OCXRN=OCXRN+1 D GETHDR(OCXRN)
..;
.D APPEND^OCXOCMP8(OCXRN,OCXD0,"C",OCXLLAB)
.I ($E(OCXLLAB,1,2)="EL") D
..S ^OCXS(860.3,"APGM",(+$E(OCXLLAB,3,$L(OCXLLAB))),(OCXLLAB_U_$$RNAM(OCXRN)))=""
.S $P(^TMP("OCXCMP",$J,"LINE",OCXD0),U,2)=$$RNAM(OCXRN)
.Q:'OCXLAST
.K OCXEXF S OCXEXF=""
.I $D(^TMP("OCXCMP",$J,"D CODE",OCXRN,"CALLS")) M OCXEXF=^("CALLS")
.S OCXSUB="" F S OCXSUB=$O(OCXEXF(OCXSUB)) Q:'$L(OCXSUB) I 'OCXEXF(OCXSUB) D
..S OCXEXF(OCXSUB)=1,OCXEXF=OCXSUB
..S OCXSUB="" F S OCXSUB=$O(^TMP("OCXCMP",$J,"INCLUDE",OCXEXF,"CALLS",OCXSUB)) Q:'$L(OCXSUB) D
...S OCXEXF(OCXSUB)=$G(OCXEXF(OCXSUB))
.S OCXSUB="" F S OCXSUB=$O(OCXEXF(OCXSUB)) Q:'$L(OCXSUB) D
..D APPEND^OCXOCMP8(OCXRN,OCXSUB,"F")
.D APPEND^OCXOCMP8(OCXRN,"$")
;
W:'$G(OCXAUTO) !,?5,"Resolve Routine Line Tags..."
S OCXD0=0 F S OCXD0=$O(^TMP("OCXCMP",$J,"D CODE",OCXD0)) Q:'OCXD0 D Q:OCXWARN
.I '$G(OCXAUTO) W:($X>60) ! W "."
.N TEXT,RTN,TEMP,ALT,LABL,OBJ,PIEC
.S RTN=$$RNAM(OCXD0)
.K TEMP M TEMP=^TMP("OCXCMP",$J,"D CODE",OCXD0)
.S OCXD1=0 F OCXOFF=0:1 S OCXD1=$O(TEMP(OCXD1)) Q:'OCXD1 D Q:OCXWARN
..N TEXT,PIEC
..S TEXT=TEMP(OCXD1,0) Q:'(TEXT["||")
..;
..F PIEC=2:2:$L(TEXT,"||") D Q:OCXWARN
...S LABL=$P(TEXT,"||",PIEC)
...I ($E(LABL,1,5)="LINE:") D I 1
....S LABL=$G(^TMP("OCXCMP",$J,"LINE",+$P(LABL,":",2)))
....I '$L(LABL) D WARN^OCXOCMPV("Line Label not found: "_$P(TEXT,"|",2),$P($T(+1)," ",1)) Q
....S:($P(LABL,"^",2)=RTN) LABL=$P(LABL,"^",1)
...;
...E I ($E(LABL,1,5)="LNTAG") D I 1
....N D0,CNT
....S D0=OCXD1 F CNT=1:1 S D0=$O(TEMP(D0),-1) Q:$L($P(TEMP(D0,0)," ",1))
....S LABL=$P(TEMP(D0,0)," ",1) S:(LABL["(") LABL=$P(LABL,"(",1)
....S LABL="(+$P($H,"","",2))_""<"_LABL_"+"_CNT_U_RTN_">"""
...;
...E D WARN^OCXOCMPV("Unknown Compiler directive: "_LABL,$P($T(+1)," ",1)) Q
...;
...S $P(TEXT,"||",PIEC)=LABL
..;
..F Q:'(TEXT["||") S TEXT=$P(TEXT,"||",1)_$P(TEXT,"||",2,999)
..S TEMP(OCXD1,0)=TEXT
.;
.K ^TMP("OCXCMP",$J,"D CODE",OCXD0)
.M ^TMP("OCXCMP",$J,"D CODE",OCXD0)=TEMP
;
Q:OCXWARN 1
W:'$G(OCXAUTO) !,?5,"Generate Subroutine and Call documentation..."
S OCXD0=0 F S OCXD0=$O(^TMP("OCXCMP",$J,"C CODE",OCXD0)) Q:'OCXD0 D CALL^OCXOCMPT(OCXD0)
;
W:'$G(OCXAUTO) !!,?5,"Delete Old OCXOZ* Routines..."
S OCXRTEST=^%ZOSF("TEST"),OCXSAVE=^%ZOSF("SAVE"),OCXDEL=^%ZOSF("DEL")
F OCXRN=1:1:1290 D
.I '$G(OCXAUTO) W:($X>60) ! W:'(OCXRN#100) "."
.S X=$$RNAM(OCXRN) X OCXRTEST I X OCXDEL W:'$G(OCXAUTO) "!"
;
W:'$G(OCXAUTO) !,?5,"File New OCXOZ* routines..."
S OCXD0=$O(^TMP("OCXCMP",$J,"D CODE",0)) Q:'OCXD0 1
F S OCXD0=$O(^TMP("OCXCMP",$J,"D CODE",OCXD0)) Q:'OCXD0 D Q:OCXWARN
.I '$G(OCXAUTO) W:($X>60) ! W "."
.D FILE^OCXOCMP8(OCXD0)
S OCXD0=$O(^TMP("OCXCMP",$J,"D CODE",0)) Q:'OCXD0 1 D FILE^OCXOCMP8(OCXD0)
;
Q OCXWARN
;
GETHDR(RNUM) ;
;
N OCXREC,D0,EFC,OCXEFF,PIEC,TEXT
S OCXREC(1,0)=$$RNAM(RNUM)_" ;SLC/RJS,CLA - Order Check Scan ;"_$$NOW
S OCXREC(2,0)=$T(+2)
S OCXREC(3,0)=$T(+3)
S OCXREC(4,0)=" ;"
S OCXREC(5,0)=" ; ***************************************************************"
S OCXREC(6,0)=" ; ** Warning: This routine is automatically generated by the **"
S OCXREC(7,0)=" ; ** Rule Compiler (^OCXOCMP) and ANY changes to this routine **"
S OCXREC(8,0)=" ; ** will be lost the next time the rule compiler executes. **"
S OCXREC(9,0)=" ; ***************************************************************"
S OCXREC(10,0)=" ;"
I (RNUM=1) D
.S OCXREC(11,0)=" ; compiled code line length: "_OCXCLL
.S OCXREC(12,0)=" ; compiled routine size: "_OCXCRS
.S OCXREC(13,0)=" ; triggered rule ignore period: "_OCXTSPI
.S OCXREC(14,0)=" ;"
.S OCXREC(15,0)=" ; Program Execution Trace Mode: "_$S($G(OCXTRACE):" ON",1:"OFF")
.S OCXREC(16,0)=" ;" ; " ; Elapsed time logging: "_$S($G(OCXTLOG):" ON",1:"OFF")
.S OCXREC(17,0)=" ; Raw Data Logging: "_$S($G(OCXDLOG):(" ON Keep data for "_OCXDLOG_" day"_$S(OCXDLOG=1:"",1:"s")_" then purge."),1:"OFF")
.S OCXREC(18,0)=" ; Compiler mode: "_$S(($G(OCXAUTO)>1):"Queued",$G(OCXAUTO):" ON",1:"OFF")
.S OCXREC(19,0)=" ; Compiled by: "_$P($G(^VA(200,+$G(DUZ),0)),U,1)_" (DUZ="_(+$G(DUZ))_")"
.S OCXREC(20,0)=" Q"
.S OCXREC(21,0)=" ;"
;
E D
.S OCXREC(11,0)=" Q"
.S OCXREC(12,0)=" ;"
;
M ^TMP("OCXCMP",$J,"D CODE",RNUM)=OCXREC
Q
;
RNAM(X) ;
N CHAR
S CHAR="0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Q "OCXOZ"_$E(CHAR,(X\36+1))_$E(CHAR,(X#36+1))
;
TODAY() N X,Y,%DT S X="T",%DT="" D ^%DT X ^DD("DD") Q Y
;
NOW() N X,Y,%DT S X="N",%DT="T" D ^%DT X ^DD("DD") S:(Y["@") Y=$P(Y,"@",1)_" at "_$P(Y,"@",2,99) Q Y
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOCXOCMP6 6393 printed Nov 22, 2024@17:34:42 Page 2
OCXOCMP6 ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Assemble Order Check Routines) ;1/05/04 14:33
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,221,243**;Dec 17,1997;Build 242
+2 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
+3 ;
EN() ;
+1 ;
+2 if $GET(OCXWARN)
QUIT 1
+3 NEW OCXD0,OCXD1,OCXRN,OCXSCNT,OCXOFF
+4 ;
+5 if '$GET(OCXAUTO)
WRITE !,?5,"Generate Extrinsic Function and Variables documentation..."
+6 SET OCXD0=0
FOR
SET OCXD0=$ORDER(^TMP("OCXCMP",$JOB,"C CODE",OCXD0))
if 'OCXD0
QUIT
DO DOC^OCXOCMPT(OCXD0)
+7 ;
+8 KILL ^OCXS(860.3,"APGM")
+9 SET OCXD0=0
FOR
SET OCXD0=$ORDER(^OCXS(860.3,OCXD0))
if 'OCXD0
QUIT
Begin DoDot:1
+10 KILL ^OCXS(860.3,OCXD0,"RTN")
IF '$GET(OCXAUTO)
if ($X>60)
WRITE !
WRITE "."
End DoDot:1
+11 ;
+12 KILL ^TMP("OCXCMP",$JOB,"D CODE")
+13 ;
+14 if '$GET(OCXAUTO)
WRITE !,?5,"Assign Subroutines to Routines..."
+15 SET OCXRN=1
SET OCXD0=0
+16 DO GETHDR(1)
+17 FOR
SET OCXD0=$ORDER(^TMP("OCXCMP",$JOB,"C CODE",OCXD0))
if 'OCXD0
QUIT
Begin DoDot:1
+18 NEW OCXLLAB,OCXSKIP,OCXEXF,OCXSUB,OCXSIZE,OCXFILE,OCXCCODE,OCXDCODE,OCXLAST
+19 IF '$GET(OCXAUTO)
if ($X>60)
WRITE !
WRITE "."
+20 SET OCXLLAB=^TMP("OCXCMP",$JOB,"LINE",OCXD0)
+21 SET OCXSKIP=((OCXLLAB="UPDATE")!(OCXLLAB="LOG"))
+22 SET OCXSIZE=$$SIZE^OCXOCMP8(OCXRN,OCXD0)
+23 SET OCXLAST='$ORDER(^TMP("OCXCMP",$JOB,"C CODE",OCXD0))
+24 SET OCXFILE=(OCXSIZE>OCXCRS)!(OCXLAST)
if OCXSKIP
SET OCXFILE=0
+25 IF OCXFILE
Begin DoDot:2
+26 KILL OCXEXF
SET OCXEXF=""
+27 IF $DATA(^TMP("OCXCMP",$JOB,"D CODE",OCXRN,"CALLS"))
MERGE OCXEXF=^("CALLS")
+28 SET OCXSUB=""
FOR
SET OCXSUB=$ORDER(OCXEXF(OCXSUB))
if '$LENGTH(OCXSUB)
QUIT
IF 'OCXEXF(OCXSUB)
Begin DoDot:3
+29 SET OCXEXF(OCXSUB)=1
SET OCXEXF=OCXSUB
+30 SET OCXSUB=""
FOR
SET OCXSUB=$ORDER(^TMP("OCXCMP",$JOB,"INCLUDE",OCXEXF,"CALLS",OCXSUB))
if '$LENGTH(OCXSUB)
QUIT
Begin DoDot:4
+31 SET OCXEXF(OCXSUB)=$GET(OCXEXF(OCXSUB))
End DoDot:4
End DoDot:3
+32 SET OCXSUB=""
FOR
SET OCXSUB=$ORDER(OCXEXF(OCXSUB))
if '$LENGTH(OCXSUB)
QUIT
Begin DoDot:3
+33 DO APPEND^OCXOCMP8(OCXRN,OCXSUB,"F")
End DoDot:3
+34 DO APPEND^OCXOCMP8(OCXRN,"$")
+35 SET OCXRN=OCXRN+1
DO GETHDR(OCXRN)
+36 ;
End DoDot:2
+37 DO APPEND^OCXOCMP8(OCXRN,OCXD0,"C",OCXLLAB)
+38 IF ($EXTRACT(OCXLLAB,1,2)="EL")
Begin DoDot:2
+39 SET ^OCXS(860.3,"APGM",(+$EXTRACT(OCXLLAB,3,$LENGTH(OCXLLAB))),(OCXLLAB_U_$$RNAM(OCXRN)))=""
End DoDot:2
+40 SET $PIECE(^TMP("OCXCMP",$JOB,"LINE",OCXD0),U,2)=$$RNAM(OCXRN)
+41 if 'OCXLAST
QUIT
+42 KILL OCXEXF
SET OCXEXF=""
+43 IF $DATA(^TMP("OCXCMP",$JOB,"D CODE",OCXRN,"CALLS"))
MERGE OCXEXF=^("CALLS")
+44 SET OCXSUB=""
FOR
SET OCXSUB=$ORDER(OCXEXF(OCXSUB))
if '$LENGTH(OCXSUB)
QUIT
IF 'OCXEXF(OCXSUB)
Begin DoDot:2
+45 SET OCXEXF(OCXSUB)=1
SET OCXEXF=OCXSUB
+46 SET OCXSUB=""
FOR
SET OCXSUB=$ORDER(^TMP("OCXCMP",$JOB,"INCLUDE",OCXEXF,"CALLS",OCXSUB))
if '$LENGTH(OCXSUB)
QUIT
Begin DoDot:3
+47 SET OCXEXF(OCXSUB)=$GET(OCXEXF(OCXSUB))
End DoDot:3
End DoDot:2
+48 SET OCXSUB=""
FOR
SET OCXSUB=$ORDER(OCXEXF(OCXSUB))
if '$LENGTH(OCXSUB)
QUIT
Begin DoDot:2
+49 DO APPEND^OCXOCMP8(OCXRN,OCXSUB,"F")
End DoDot:2
+50 DO APPEND^OCXOCMP8(OCXRN,"$")
End DoDot:1
if OCXWARN
QUIT
+51 ;
+52 if '$GET(OCXAUTO)
WRITE !,?5,"Resolve Routine Line Tags..."
+53 SET OCXD0=0
FOR
SET OCXD0=$ORDER(^TMP("OCXCMP",$JOB,"D CODE",OCXD0))
if 'OCXD0
QUIT
Begin DoDot:1
+54 IF '$GET(OCXAUTO)
if ($X>60)
WRITE !
WRITE "."
+55 NEW TEXT,RTN,TEMP,ALT,LABL,OBJ,PIEC
+56 SET RTN=$$RNAM(OCXD0)
+57 KILL TEMP
MERGE TEMP=^TMP("OCXCMP",$JOB,"D CODE",OCXD0)
+58 SET OCXD1=0
FOR OCXOFF=0:1
SET OCXD1=$ORDER(TEMP(OCXD1))
if 'OCXD1
QUIT
Begin DoDot:2
+59 NEW TEXT,PIEC
+60 SET TEXT=TEMP(OCXD1,0)
if '(TEXT["||")
QUIT
+61 ;
+62 FOR PIEC=2:2:$LENGTH(TEXT,"||")
Begin DoDot:3
+63 SET LABL=$PIECE(TEXT,"||",PIEC)
+64 IF ($EXTRACT(LABL,1,5)="LINE:")
Begin DoDot:4
+65 SET LABL=$GET(^TMP("OCXCMP",$JOB,"LINE",+$PIECE(LABL,":",2)))
+66 IF '$LENGTH(LABL)
DO WARN^OCXOCMPV("Line Label not found: "_$PIECE(TEXT,"|",2),$PIECE($TEXT(+1)," ",1))
QUIT
+67 if ($PIECE(LABL,"^",2)=RTN)
SET LABL=$PIECE(LABL,"^",1)
End DoDot:4
IF 1
+68 ;
+69 IF '$TEST
IF ($EXTRACT(LABL,1,5)="LNTAG")
Begin DoDot:4
+70 NEW D0,CNT
+71 SET D0=OCXD1
FOR CNT=1:1
SET D0=$ORDER(TEMP(D0),-1)
if $LENGTH($PIECE(TEMP(D0,0)," ",1))
QUIT
+72 SET LABL=$PIECE(TEMP(D0,0)," ",1)
if (LABL["(")
SET LABL=$PIECE(LABL,"(",1)
+73 SET LABL="(+$P($H,"","",2))_""<"_LABL_"+"_CNT_U_RTN_">"""
End DoDot:4
IF 1
+74 ;
+75 IF '$TEST
DO WARN^OCXOCMPV("Unknown Compiler directive: "_LABL,$PIECE($TEXT(+1)," ",1))
QUIT
+76 ;
+77 SET $PIECE(TEXT,"||",PIEC)=LABL
End DoDot:3
if OCXWARN
QUIT
+78 ;
+79 FOR
if '(TEXT["||")
QUIT
SET TEXT=$PIECE(TEXT,"||",1)_$PIECE(TEXT,"||",2,999)
+80 SET TEMP(OCXD1,0)=TEXT
End DoDot:2
if OCXWARN
QUIT
+81 ;
+82 KILL ^TMP("OCXCMP",$JOB,"D CODE",OCXD0)
+83 MERGE ^TMP("OCXCMP",$JOB,"D CODE",OCXD0)=TEMP
End DoDot:1
if OCXWARN
QUIT
+84 ;
+85 if OCXWARN
QUIT 1
+86 if '$GET(OCXAUTO)
WRITE !,?5,"Generate Subroutine and Call documentation..."
+87 SET OCXD0=0
FOR
SET OCXD0=$ORDER(^TMP("OCXCMP",$JOB,"C CODE",OCXD0))
if 'OCXD0
QUIT
DO CALL^OCXOCMPT(OCXD0)
+88 ;
+89 if '$GET(OCXAUTO)
WRITE !!,?5,"Delete Old OCXOZ* Routines..."
+90 SET OCXRTEST=^%ZOSF("TEST")
SET OCXSAVE=^%ZOSF("SAVE")
SET OCXDEL=^%ZOSF("DEL")
+91 FOR OCXRN=1:1:1290
Begin DoDot:1
+92 IF '$GET(OCXAUTO)
if ($X>60)
WRITE !
if '(OCXRN#100)
WRITE "."
+93 SET X=$$RNAM(OCXRN)
XECUTE OCXRTEST
IF $TEST
XECUTE OCXDEL
if '$GET(OCXAUTO)
WRITE "!"
End DoDot:1
+94 ;
+95 if '$GET(OCXAUTO)
WRITE !,?5,"File New OCXOZ* routines..."
+96 SET OCXD0=$ORDER(^TMP("OCXCMP",$JOB,"D CODE",0))
if 'OCXD0
QUIT 1
+97 FOR
SET OCXD0=$ORDER(^TMP("OCXCMP",$JOB,"D CODE",OCXD0))
if 'OCXD0
QUIT
Begin DoDot:1
+98 IF '$GET(OCXAUTO)
if ($X>60)
WRITE !
WRITE "."
+99 DO FILE^OCXOCMP8(OCXD0)
End DoDot:1
if OCXWARN
QUIT
+100 SET OCXD0=$ORDER(^TMP("OCXCMP",$JOB,"D CODE",0))
if 'OCXD0
QUIT 1
DO FILE^OCXOCMP8(OCXD0)
+101 ;
+102 QUIT OCXWARN
+103 ;
GETHDR(RNUM) ;
+1 ;
+2 NEW OCXREC,D0,EFC,OCXEFF,PIEC,TEXT
+3 SET OCXREC(1,0)=$$RNAM(RNUM)_" ;SLC/RJS,CLA - Order Check Scan ;"_$$NOW
+4 SET OCXREC(2,0)=$TEXT(+2)
+5 SET OCXREC(3,0)=$TEXT(+3)
+6 SET OCXREC(4,0)=" ;"
+7 SET OCXREC(5,0)=" ; ***************************************************************"
+8 SET OCXREC(6,0)=" ; ** Warning: This routine is automatically generated by the **"
+9 SET OCXREC(7,0)=" ; ** Rule Compiler (^OCXOCMP) and ANY changes to this routine **"
+10 SET OCXREC(8,0)=" ; ** will be lost the next time the rule compiler executes. **"
+11 SET OCXREC(9,0)=" ; ***************************************************************"
+12 SET OCXREC(10,0)=" ;"
+13 IF (RNUM=1)
Begin DoDot:1
+14 SET OCXREC(11,0)=" ; compiled code line length: "_OCXCLL
+15 SET OCXREC(12,0)=" ; compiled routine size: "_OCXCRS
+16 SET OCXREC(13,0)=" ; triggered rule ignore period: "_OCXTSPI
+17 SET OCXREC(14,0)=" ;"
+18 SET OCXREC(15,0)=" ; Program Execution Trace Mode: "_$SELECT($GET(OCXTRACE):" ON",1:"OFF")
+19 ; " ; Elapsed time logging: "_$S($G(OCXTLOG):" ON",1:"OFF")
SET OCXREC(16,0)=" ;"
+20 SET OCXREC(17,0)=" ; Raw Data Logging: "_$SELECT($GET(OCXDLOG):(" ON Keep data for "_OCXDLOG_" day"_$SELECT(OCXDLOG=1:"",1:"s")_" then purge."),1:"OFF")
+21 SET OCXREC(18,0)=" ; Compiler mode: "_$SELECT(($GET(OCXAUTO)>1):"Queued",$GET(OCXAUTO):" ON",1:"OFF")
+22 SET OCXREC(19,0)=" ; Compiled by: "_$PIECE($GET(^VA(200,+$GET(DUZ),0)),U,1)_" (DUZ="_(+$GET(DUZ))_")"
+23 SET OCXREC(20,0)=" Q"
+24 SET OCXREC(21,0)=" ;"
End DoDot:1
+25 ;
+26 IF '$TEST
Begin DoDot:1
+27 SET OCXREC(11,0)=" Q"
+28 SET OCXREC(12,0)=" ;"
End DoDot:1
+29 ;
+30 MERGE ^TMP("OCXCMP",$JOB,"D CODE",RNUM)=OCXREC
+31 QUIT
+32 ;
RNAM(X) ;
+1 NEW CHAR
+2 SET CHAR="0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+3 QUIT "OCXOZ"_$EXTRACT(CHAR,(X\36+1))_$EXTRACT(CHAR,(X#36+1))
+4 ;
TODAY() NEW X,Y,%DT
SET X="T"
SET %DT=""
DO ^%DT
XECUTE ^DD("DD")
QUIT Y
+1 ;
NOW() NEW X,Y,%DT
SET X="N"
SET %DT="T"
DO ^%DT
XECUTE ^DD("DD")
if (Y["@")
SET Y=$PIECE(Y,"@",1)_" at "_$PIECE(Y,"@",2,99)
QUIT Y
+1 ;
