Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: OCXOCMP6

OCXOCMP6.m

Go to the documentation of this file. 
  1. 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
  1.  ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
  1.  ;
  1. EN() ;
  1.  ;
  1.  Q:$G(OCXWARN) 1
  1.  N OCXD0,OCXD1,OCXRN,OCXSCNT,OCXOFF
  1.  ;
  1.  W:'$G(OCXAUTO) !,?5,"Generate Extrinsic Function and Variables documentation..."
  1.  S OCXD0=0 F  S OCXD0=$O(^TMP("OCXCMP",$J,"C CODE",OCXD0)) Q:'OCXD0  D DOC^OCXOCMPT(OCXD0)
  1.  ;
  1.  K ^OCXS(860.3,"APGM")
  1.  S OCXD0=0 F  S OCXD0=$O(^OCXS(860.3,OCXD0)) Q:'OCXD0  D
  1.  .K ^OCXS(860.3,OCXD0,"RTN") I '$G(OCXAUTO) W:($X>60) ! W "."
  1.  ;
  1.  K ^TMP("OCXCMP",$J,"D CODE")
  1.  ;
  1.  W:'$G(OCXAUTO) !,?5,"Assign Subroutines to Routines..."
  1.  S OCXRN=1,OCXD0=0
  1.  D GETHDR(1)
  1.  F  S OCXD0=$O(^TMP("OCXCMP",$J,"C CODE",OCXD0)) Q:'OCXD0  D  Q:OCXWARN
  1.  .N OCXLLAB,OCXSKIP,OCXEXF,OCXSUB,OCXSIZE,OCXFILE,OCXCCODE,OCXDCODE,OCXLAST
  1.  .I '$G(OCXAUTO) W:($X>60) ! W "."
  1.  .S OCXLLAB=^TMP("OCXCMP",$J,"LINE",OCXD0)
  1.  .S OCXSKIP=((OCXLLAB="UPDATE")!(OCXLLAB="LOG"))
  1.  .S OCXSIZE=$$SIZE^OCXOCMP8(OCXRN,OCXD0)
  1.  .S OCXLAST='$O(^TMP("OCXCMP",$J,"C CODE",OCXD0))
  1.  .S OCXFILE=(OCXSIZE>OCXCRS)!(OCXLAST) S:OCXSKIP OCXFILE=0
  1.  .I OCXFILE D
  1.  ..K OCXEXF S OCXEXF=""
  1.  ..I $D(^TMP("OCXCMP",$J,"D CODE",OCXRN,"CALLS")) M OCXEXF=^("CALLS")
  1.  ..S OCXSUB="" F  S OCXSUB=$O(OCXEXF(OCXSUB)) Q:'$L(OCXSUB)  I 'OCXEXF(OCXSUB) D
  1.  ...S OCXEXF(OCXSUB)=1,OCXEXF=OCXSUB
  1.  ...S OCXSUB="" F  S OCXSUB=$O(^TMP("OCXCMP",$J,"INCLUDE",OCXEXF,"CALLS",OCXSUB)) Q:'$L(OCXSUB)  D
  1.  ....S OCXEXF(OCXSUB)=$G(OCXEXF(OCXSUB))
  1.  ..S OCXSUB="" F  S OCXSUB=$O(OCXEXF(OCXSUB)) Q:'$L(OCXSUB)  D
  1.  ...D APPEND^OCXOCMP8(OCXRN,OCXSUB,"F")
  1.  ..D APPEND^OCXOCMP8(OCXRN,"$")
  1.  ..S OCXRN=OCXRN+1 D GETHDR(OCXRN)
  1.  ..;
  1.  .D APPEND^OCXOCMP8(OCXRN,OCXD0,"C",OCXLLAB)
  1.  .I ($E(OCXLLAB,1,2)="EL") D
  1.  ..S ^OCXS(860.3,"APGM",(+$E(OCXLLAB,3,$L(OCXLLAB))),(OCXLLAB_U_$$RNAM(OCXRN)))=""
  1.  .S $P(^TMP("OCXCMP",$J,"LINE",OCXD0),U,2)=$$RNAM(OCXRN)
  1.  .Q:'OCXLAST
  1.  .K OCXEXF S OCXEXF=""
  1.  .I $D(^TMP("OCXCMP",$J,"D CODE",OCXRN,"CALLS")) M OCXEXF=^("CALLS")
  1.  .S OCXSUB="" F  S OCXSUB=$O(OCXEXF(OCXSUB)) Q:'$L(OCXSUB)  I 'OCXEXF(OCXSUB) D
  1.  ..S OCXEXF(OCXSUB)=1,OCXEXF=OCXSUB
  1.  ..S OCXSUB="" F  S OCXSUB=$O(^TMP("OCXCMP",$J,"INCLUDE",OCXEXF,"CALLS",OCXSUB)) Q:'$L(OCXSUB)  D
  1.  ...S OCXEXF(OCXSUB)=$G(OCXEXF(OCXSUB))
  1.  .S OCXSUB="" F  S OCXSUB=$O(OCXEXF(OCXSUB)) Q:'$L(OCXSUB)  D
  1.  ..D APPEND^OCXOCMP8(OCXRN,OCXSUB,"F")
  1.  .D APPEND^OCXOCMP8(OCXRN,"$")
  1.  ;
  1.  W:'$G(OCXAUTO) !,?5,"Resolve Routine Line Tags..."
  1.  S OCXD0=0 F  S OCXD0=$O(^TMP("OCXCMP",$J,"D CODE",OCXD0)) Q:'OCXD0  D  Q:OCXWARN
  1.  .I '$G(OCXAUTO) W:($X>60) ! W "."
  1.  .N TEXT,RTN,TEMP,ALT,LABL,OBJ,PIEC
  1.  .S RTN=$$RNAM(OCXD0)
  1.  .K TEMP M TEMP=^TMP("OCXCMP",$J,"D CODE",OCXD0)
  1.  .S OCXD1=0 F OCXOFF=0:1 S OCXD1=$O(TEMP(OCXD1)) Q:'OCXD1  D  Q:OCXWARN
  1.  ..N TEXT,PIEC
  1.  ..S TEXT=TEMP(OCXD1,0) Q:'(TEXT["||")
  1.  ..;
  1.  ..F PIEC=2:2:$L(TEXT,"||") D  Q:OCXWARN
  1.  ...S LABL=$P(TEXT,"||",PIEC)
  1.  ...I ($E(LABL,1,5)="LINE:") D  I 1
  1.  ....S LABL=$G(^TMP("OCXCMP",$J,"LINE",+$P(LABL,":",2)))
  1.  ....I '$L(LABL) D WARN^OCXOCMPV("Line Label not found: "_$P(TEXT,"|",2),$P($T(+1)," ",1)) Q
  1.  ....S:($P(LABL,"^",2)=RTN) LABL=$P(LABL,"^",1)
  1.  ...;
  1.  ...E  I ($E(LABL,1,5)="LNTAG") D  I 1
  1.  ....N D0,CNT
  1.  ....S D0=OCXD1 F CNT=1:1 S D0=$O(TEMP(D0),-1)  Q:$L($P(TEMP(D0,0)," ",1))
  1.  ....S LABL=$P(TEMP(D0,0)," ",1) S:(LABL["(") LABL=$P(LABL,"(",1)
  1.  ....S LABL="(+$P($H,"","",2))_""<"_LABL_"+"_CNT_U_RTN_">"""
  1.  ...;
  1.  ...E  D WARN^OCXOCMPV("Unknown Compiler directive: "_LABL,$P($T(+1)," ",1)) Q
  1.  ...;
  1.  ...S $P(TEXT,"||",PIEC)=LABL
  1.  ..;
  1.  ..F  Q:'(TEXT["||")  S TEXT=$P(TEXT,"||",1)_$P(TEXT,"||",2,999)
  1.  ..S TEMP(OCXD1,0)=TEXT
  1.  .;
  1.  .K ^TMP("OCXCMP",$J,"D CODE",OCXD0)
  1.  .M ^TMP("OCXCMP",$J,"D CODE",OCXD0)=TEMP
  1.  ;
  1.  Q:OCXWARN 1
  1.  W:'$G(OCXAUTO) !,?5,"Generate Subroutine and Call documentation..."
  1.  S OCXD0=0 F  S OCXD0=$O(^TMP("OCXCMP",$J,"C CODE",OCXD0)) Q:'OCXD0  D CALL^OCXOCMPT(OCXD0)
  1.  ;
  1.  W:'$G(OCXAUTO) !!,?5,"Delete Old OCXOZ* Routines..."
  1.  S OCXRTEST=^%ZOSF("TEST"),OCXSAVE=^%ZOSF("SAVE"),OCXDEL=^%ZOSF("DEL")
  1.  F OCXRN=1:1:1290 D
  1.  .I '$G(OCXAUTO) W:($X>60) ! W:'(OCXRN#100) "."
  1.  .S X=$$RNAM(OCXRN) X OCXRTEST I  X OCXDEL W:'$G(OCXAUTO) "!"
  1.  ;
  1.  W:'$G(OCXAUTO) !,?5,"File New OCXOZ* routines..."
  1.  S OCXD0=$O(^TMP("OCXCMP",$J,"D CODE",0)) Q:'OCXD0 1
  1.  F  S OCXD0=$O(^TMP("OCXCMP",$J,"D CODE",OCXD0)) Q:'OCXD0  D  Q:OCXWARN
  1.  .I '$G(OCXAUTO) W:($X>60) ! W "."
  1.  .D FILE^OCXOCMP8(OCXD0)
  1.  S OCXD0=$O(^TMP("OCXCMP",$J,"D CODE",0)) Q:'OCXD0 1  D FILE^OCXOCMP8(OCXD0)
  1.  ;
  1.  Q OCXWARN
  1.  ;
  1. GETHDR(RNUM) ;
  1.  ;
  1.  N OCXREC,D0,EFC,OCXEFF,PIEC,TEXT
  1.  S OCXREC(1,0)=$$RNAM(RNUM)_" ;SLC/RJS,CLA - Order Check Scan ;"_$$NOW
  1.  S OCXREC(2,0)=$T(+2)
  1.  S OCXREC(3,0)=$T(+3)
  1.  S OCXREC(4,0)=" ;"
  1.  S OCXREC(5,0)=" ; ***************************************************************"
  1.  S OCXREC(6,0)=" ; ** Warning: This routine is automatically generated by the   **"
  1.  S OCXREC(7,0)=" ; ** Rule Compiler (^OCXOCMP) and ANY changes to this routine  **"
  1.  S OCXREC(8,0)=" ; ** will be lost the next time the rule compiler executes.    **"
  1.  S OCXREC(9,0)=" ; ***************************************************************"
  1.  S OCXREC(10,0)=" ;"
  1.  I (RNUM=1) D
  1.  .S OCXREC(11,0)=" ;    compiled code line length: "_OCXCLL
  1.  .S OCXREC(12,0)=" ;        compiled routine size: "_OCXCRS
  1.  .S OCXREC(13,0)=" ; triggered rule ignore period: "_OCXTSPI
  1.  .S OCXREC(14,0)=" ;"
  1.  .S OCXREC(15,0)=" ;   Program Execution Trace Mode: "_$S($G(OCXTRACE):" ON",1:"OFF")
  1.  .S OCXREC(16,0)=" ;" ; " ;    Elapsed time logging: "_$S($G(OCXTLOG):" ON",1:"OFF")
  1.  .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")
  1.  .S OCXREC(18,0)=" ; Compiler mode: "_$S(($G(OCXAUTO)>1):"Queued",$G(OCXAUTO):" ON",1:"OFF")
  1.  .S OCXREC(19,0)=" ;   Compiled by: "_$P($G(^VA(200,+$G(DUZ),0)),U,1)_"  (DUZ="_(+$G(DUZ))_")"
  1.  .S OCXREC(20,0)=" Q"
  1.  .S OCXREC(21,0)=" ;"
  1.  ;
  1.  E  D
  1.  .S OCXREC(11,0)=" Q"
  1.  .S OCXREC(12,0)=" ;"
  1.  ;
  1.  M ^TMP("OCXCMP",$J,"D CODE",RNUM)=OCXREC
  1.  Q
  1.  ;
  1. RNAM(X) ;
  1.  N CHAR
  1.  S CHAR="0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  1.  Q "OCXOZ"_$E(CHAR,(X\36+1))_$E(CHAR,(X#36+1))
  1.  ;
  1. TODAY() N X,Y,%DT S X="T",%DT="" D ^%DT X ^DD("DD") Q Y
  1.  ;
  1. 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
  1.  ;