72 lines
2.7 KiB
Mathematica
72 lines
2.7 KiB
Mathematica
OCXOCMPO ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Get Compiler Function Subroutines) ;2/02/99 12:58
|
|
;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
|
|
;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
|
|
;
|
|
EN() ;
|
|
;
|
|
N OCXD0,OCXD1,OCXSR,OCXNAME
|
|
;
|
|
S (OCXWARN,OCXD0)=0 F S OCXD0=$O(^OCXS(860.8,OCXD0)) Q:'OCXD0 D Q:OCXWARN
|
|
.;
|
|
.I '$G(OCXAUTO) W:($X>60) ! W "."
|
|
.;
|
|
.K OCXSR M OCXSR=^OCXS(860.8,OCXD0,"CODE")
|
|
.K OCXSR(0)
|
|
.S OCXD1=0 F S OCXD1=$O(OCXSR(OCXD1)) Q:'OCXD1 D
|
|
..S OCXMODE=$P(OCXSR(OCXD1,0),";",1)
|
|
..S OCXSR(OCXD1,0)=$P(OCXSR(OCXD1,0),";",2,999)
|
|
..F Q:'(OCXSR(OCXD1,0)["%%%%") S OCXSR(OCXD1,0)=$P(OCXSR(OCXD1,0),"""%%%%""",1)_"||LNTAG||"_$P(OCXSR(OCXD1,0),"""%%%%""",2,999)
|
|
..I (OCXMODE["T+"),'OCXTRACE K OCXSR(OCXD1)
|
|
..I (OCXMODE["T-"),OCXTRACE K OCXSR(OCXD1)
|
|
..I (OCXMODE["L+"),'OCXTLOG K OCXSR(OCXD1)
|
|
.D REINDEX(.OCXSR,0)
|
|
.Q:'$D(OCXSR(1,0))
|
|
.I (OCXSR(1,0)[";"),'$L($P(OCXSR(1,0),";",2)) S OCXSR(1,0)=OCXSR(1,0)_" Compiler Function: "_$P($G(^OCXS(860.8,OCXD0,0)),U,1)
|
|
.S OCXNAME=$P(OCXSR(1,0),";",1)
|
|
.S:(OCXNAME["(") OCXNAME=$P(OCXNAME,"(",1)
|
|
.I '$L(OCXNAME) D WARN^OCXOCMPV("Subroutine Name Not found",8,OCXD0,"EN+20^OCXOCMPO") Q
|
|
.;
|
|
.I OCXTRACE D
|
|
..F OCXD1=1:1,0 I OCXD1 Q:'$D(OCXSR(OCXD1,0)) Q:'($E($P(OCXSR(OCXD1,0)," ",2),1)=";")
|
|
..I OCXD1 S:(OCXD1>1) OCXD1=OCXD1-1 D
|
|
...N OCXPC,OCXARG,OCXARGL
|
|
...S OCXSR(OCXD1+.0001,0)=" W:$G(OCXTRACE) !,||LNTAG||,?27,""Compiler Function "_$P(OCXSR(1,0),";",1)_" Execution trace. """
|
|
...S OCXARGL=$P(OCXSR(1,0),";",1) Q:'(OCXARGL["(")
|
|
...S OCXARGL=$P($P(OCXARGL,"(",2),")",1)
|
|
...F OCXPC=1:1:$L(OCXARGL,",") S OCXARG=$P(OCXARGL,",",OCXPC) D
|
|
....S OCXSR(OCXD1+(OCXPC/100),0)=" W:$G(OCXTRACE) !,?35,"" "_$E(" ",1,(9-$L(OCXARG)))_OCXARG_": "",$G("_OCXARG_")"
|
|
...S OCXSR(OCXD1+(OCXPC+1/100),0)=" W:$G(OCXTRACE) !"
|
|
..D REINDEX(.OCXSR,0)
|
|
.;
|
|
.M ^TMP("OCXCMP",$J,"INCLUDE",OCXNAME)=OCXSR
|
|
.;
|
|
Q:OCXWARN 1
|
|
;
|
|
; Build local term lookup function
|
|
;
|
|
D TERMLKUP^OCXOCMPU
|
|
;
|
|
S OCXNAME="" F S OCXNAME=$O(^TMP("OCXCMP",$J,"INCLUDE",OCXNAME)) Q:'$L(OCXNAME) D
|
|
.N LAST,SIZE,CALL,PC,SUBR
|
|
.K OCXSR M OCXSR=^TMP("OCXCMP",$J,"INCLUDE",OCXNAME)
|
|
.S LAST=$O(OCXSR(" "),-1)
|
|
.S:'($G(OCXSR(LAST,0))=" ;") OCXSR(LAST+1,0)=" ;"
|
|
.S OCXD1=0 F S OCXD1=$O(OCXSR(OCXD1)) Q:'OCXD1 D
|
|
..S SIZE=$G(SIZE)+$L(OCXSR(OCXD1,0))
|
|
..F PC=2:1:$L(OCXSR(OCXD1,0),"$$") D
|
|
...S SUBR=$P($P(OCXSR(OCXD1,0),"$$",PC),"(",1)
|
|
...I $D(^TMP("OCXCMP",$J,"INCLUDE",SUBR)) S OCXSR("CALLS",SUBR)=""
|
|
.S OCXSR("SIZE")=SIZE
|
|
.K ^TMP("OCXCMP",$J,"INCLUDE",OCXNAME)
|
|
.M ^TMP("OCXCMP",$J,"INCLUDE",OCXNAME)=OCXSR
|
|
;
|
|
Q 0
|
|
;
|
|
REINDEX(ARRAY,NDX2) ;
|
|
;
|
|
N TEMP,NDX1 M TEMP=ARRAY K ARRAY
|
|
S NDX1="" F S NDX1=$O(TEMP(NDX1)) Q:'$L(NDX1) D
|
|
.I $L(TEMP(NDX1,0)) S NDX2=NDX2+1 M ARRAY(NDX2)=TEMP(NDX1)
|
|
Q
|
|
;
|