source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXOCMPO.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.7 KB
Line 
1OCXOCMPO ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Get Compiler Function Subroutines) ;2/02/99 12:58
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
3 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
4 ;
5EN() ;
6 ;
7 N OCXD0,OCXD1,OCXSR,OCXNAME
8 ;
9 S (OCXWARN,OCXD0)=0 F S OCXD0=$O(^OCXS(860.8,OCXD0)) Q:'OCXD0 D Q:OCXWARN
10 .;
11 .I '$G(OCXAUTO) W:($X>60) ! W "."
12 .;
13 .K OCXSR M OCXSR=^OCXS(860.8,OCXD0,"CODE")
14 .K OCXSR(0)
15 .S OCXD1=0 F S OCXD1=$O(OCXSR(OCXD1)) Q:'OCXD1 D
16 ..S OCXMODE=$P(OCXSR(OCXD1,0),";",1)
17 ..S OCXSR(OCXD1,0)=$P(OCXSR(OCXD1,0),";",2,999)
18 ..F Q:'(OCXSR(OCXD1,0)["%%%%") S OCXSR(OCXD1,0)=$P(OCXSR(OCXD1,0),"""%%%%""",1)_"||LNTAG||"_$P(OCXSR(OCXD1,0),"""%%%%""",2,999)
19 ..I (OCXMODE["T+"),'OCXTRACE K OCXSR(OCXD1)
20 ..I (OCXMODE["T-"),OCXTRACE K OCXSR(OCXD1)
21 ..I (OCXMODE["L+"),'OCXTLOG K OCXSR(OCXD1)
22 .D REINDEX(.OCXSR,0)
23 .Q:'$D(OCXSR(1,0))
24 .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)
25 .S OCXNAME=$P(OCXSR(1,0),";",1)
26 .S:(OCXNAME["(") OCXNAME=$P(OCXNAME,"(",1)
27 .I '$L(OCXNAME) D WARN^OCXOCMPV("Subroutine Name Not found",8,OCXD0,"EN+20^OCXOCMPO") Q
28 .;
29 .I OCXTRACE D
30 ..F OCXD1=1:1,0 I OCXD1 Q:'$D(OCXSR(OCXD1,0)) Q:'($E($P(OCXSR(OCXD1,0)," ",2),1)=";")
31 ..I OCXD1 S:(OCXD1>1) OCXD1=OCXD1-1 D
32 ...N OCXPC,OCXARG,OCXARGL
33 ...S OCXSR(OCXD1+.0001,0)=" W:$G(OCXTRACE) !,||LNTAG||,?27,""Compiler Function "_$P(OCXSR(1,0),";",1)_" Execution trace. """
34 ...S OCXARGL=$P(OCXSR(1,0),";",1) Q:'(OCXARGL["(")
35 ...S OCXARGL=$P($P(OCXARGL,"(",2),")",1)
36 ...F OCXPC=1:1:$L(OCXARGL,",") S OCXARG=$P(OCXARGL,",",OCXPC) D
37 ....S OCXSR(OCXD1+(OCXPC/100),0)=" W:$G(OCXTRACE) !,?35,"" "_$E(" ",1,(9-$L(OCXARG)))_OCXARG_": "",$G("_OCXARG_")"
38 ...S OCXSR(OCXD1+(OCXPC+1/100),0)=" W:$G(OCXTRACE) !"
39 ..D REINDEX(.OCXSR,0)
40 .;
41 .M ^TMP("OCXCMP",$J,"INCLUDE",OCXNAME)=OCXSR
42 .;
43 Q:OCXWARN 1
44 ;
45 ; Build local term lookup function
46 ;
47 D TERMLKUP^OCXOCMPU
48 ;
49 S OCXNAME="" F S OCXNAME=$O(^TMP("OCXCMP",$J,"INCLUDE",OCXNAME)) Q:'$L(OCXNAME) D
50 .N LAST,SIZE,CALL,PC,SUBR
51 .K OCXSR M OCXSR=^TMP("OCXCMP",$J,"INCLUDE",OCXNAME)
52 .S LAST=$O(OCXSR(" "),-1)
53 .S:'($G(OCXSR(LAST,0))=" ;") OCXSR(LAST+1,0)=" ;"
54 .S OCXD1=0 F S OCXD1=$O(OCXSR(OCXD1)) Q:'OCXD1 D
55 ..S SIZE=$G(SIZE)+$L(OCXSR(OCXD1,0))
56 ..F PC=2:1:$L(OCXSR(OCXD1,0),"$$") D
57 ...S SUBR=$P($P(OCXSR(OCXD1,0),"$$",PC),"(",1)
58 ...I $D(^TMP("OCXCMP",$J,"INCLUDE",SUBR)) S OCXSR("CALLS",SUBR)=""
59 .S OCXSR("SIZE")=SIZE
60 .K ^TMP("OCXCMP",$J,"INCLUDE",OCXNAME)
61 .M ^TMP("OCXCMP",$J,"INCLUDE",OCXNAME)=OCXSR
62 ;
63 Q 0
64 ;
65REINDEX(ARRAY,NDX2) ;
66 ;
67 N TEMP,NDX1 M TEMP=ARRAY K ARRAY
68 S NDX1="" F S NDX1=$O(TEMP(NDX1)) Q:'$L(NDX1) D
69 .I $L(TEMP(NDX1,0)) S NDX2=NDX2+1 M ARRAY(NDX2)=TEMP(NDX1)
70 Q
71 ;
Note: See TracBrowser for help on using the repository browser.