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

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
 ;