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

OCXOCMPL.m

Go to the documentation of this file. 
  1. OCXOCMPL ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Compile Complex Rule Element Expressions) ;10/29/98  12:37
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
  1.  ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
  1.  ;
  1. EN ;
  1.  ;
  1.  Q
  1.  ;
  1. GETC(OCXD0,OCXEXP,OCXDTYP,OCXCD) ;
  1.  ;
  1.  N OCXCHR,OCXCOD1,OCXCODE,OCXD2,OCXNULL,OCXOPC,OCXOPER,OCXOPN,OCXP,OCXPOS,OCXPTR1,OCXPTR2,OCXVNAM,OCXITEM
  1.  ;
  1.  F OCXPTR1=1:1:$L(OCXEXP) S OCXCHR=$E(OCXEXP,OCXPTR1) D
  1.  .;
  1.  .I (OCXCHR="|") D  Q
  1.  ..F OCXPTR2=(OCXPTR1+1):1:$L(OCXEXP) Q:($E(OCXEXP,OCXPTR2)="|")
  1.  ..S OCXITEM($O(OCXITEM(""),-1)+1)=$$STSPAC($E(OCXEXP,OCXPTR1+1,OCXPTR2-1)),OCXPTR1=OCXPTR2
  1.  .;
  1.  .I (OCXCHR="""") D  Q
  1.  ..F OCXPTR2=(OCXPTR1+1):1:$L(OCXEXP) Q:($E(OCXEXP,OCXPTR2)="""")
  1.  ..S OCXITEM($O(OCXITEM(""),-1)+1)=$$STSPAC($E(OCXEXP,OCXPTR1+1,OCXPTR2-1)),OCXPTR1=OCXPTR2
  1.  .;
  1.  .I (OCXCHR?1A) D  Q
  1.  ..F OCXPTR2=(OCXPTR1+1):1:$L(OCXEXP) Q:($E(OCXEXP,OCXPTR2)="""")  Q:($E(OCXEXP,OCXPTR2)="|")
  1.  ..S OCXITEM($O(OCXITEM(""),-1)+1)=$$STSPAC($E(OCXEXP,OCXPTR1,OCXPTR2-1)),OCXPTR1=OCXPTR2-1
  1.  ;
  1.  S OCXOPER=$$OPER(OCXITEM(2),OCXDTYP)
  1.  I '(OCXOPER) D WARN^OCXOCMPV("Operator/Function ("_OCXDTYP_") '"_OCXITEM(2)_"' not defined...",3,OCXEL,$P($T(+1)," ",1)) Q ""
  1.  S OCXOPN=$P($G(^OCXS(863.9,OCXOPER,0)),U,1)
  1.  S OCXOPC=$$GETPARM^OCXOCMPE(39,OCXOPER,"OCXO GENERATE CODE FUNCTION")
  1.  I '$L(OCXOPC) D WARN^OCXOCMPV("'"_OCXOPN_"' Operator 'OCXO GENERATE CODE FUNCTION' parameter not defined",3,OCXEL,$P($T(+1)," ",1)) Q ""
  1.  S:'(OCXOPC=+OCXOPC) OCXOPC=$$GETIEN("^OCXS(863.7)",OCXOPC)
  1.  I '$D(^OCXS(863.7,+OCXOPC,0)) D WARN^OCXOCMPV("'"_OCXOPN_"' Operator 'OCXO GENERATE CODE FUNCTION' Public Function not defined",3,OCXEL,$P($T(+1)," ",1)) Q ""
  1.  S OCXP=$G(^OCXS(863.7,+OCXOPC,"EX")) I '$L(OCXP) D WARN^OCXOCMPV("Operator ("_(+OCXOPC)_") '"_$P($G(^OCXS(863.9,+OCXOPC,0)),U,1)_"' executable not defined",3,OCXEL,$P($T(+1)," ",1)) Q ""
  1.  S OCXD2=0 F  S OCXD2=$O(^OCXS(863.7,+OCXOPC,"PAR",OCXD2)) Q:'OCXD2  D
  1.  .N OCXPOS,OCXVNAM
  1.  .S OCXPOS=+$G(^OCXS(863.7,+OCXOPC,"PAR",OCXD2,"IN")) Q:'OCXPOS  Q:$D(OCXP(OCXPOS))
  1.  .S OCXVNAM=+$G(^OCXS(863.7,+OCXOPC,"PAR",OCXD2,0)) Q:'OCXVNAM
  1.  .S OCXVNAM=$P($G(^OCXS(863.8,+OCXVNAM,0)),U,2) Q:'$L(OCXVNAM)
  1.  .S OCXP(+OCXPOS)=OCXVNAM,OCXP(OCXVNAM)=""
  1.  ;
  1.  S OCXNULL=$$GETPARM(39,OCXOPER,"OCXO NULL VALUE ALLOWED")
  1.  I '$D(OCXP("PDFLD")) D WARN^OCXOCMPV("CMPE1 Primary Data field not defined",3,OCXD0,$P($T(+1)," ",1)) Q ""
  1.  I $D(OCXP("PDFLD")) S OCXP("PDFLD")=OCXITEM(1)
  1.  I '$L(OCXP("PDFLD")) D WARN^OCXOCMPV("CMPE2 Primary Data field not defined",3,OCXD0,$P($T(+1)," ",1)) Q ""
  1.  ;
  1.  I $D(OCXP("CVAL")) D  I '$L(OCXP("CVAL")) D WARN^OCXOCMPV("Comparison Value/Field not defined",3,OCXD0,$P($T(+1)," ",1)) Q ""
  1.  .S OCXP("CVAL")=OCXITEM(3)
  1.  .I '$L(OCXP("CVAL")) S OCXP("CVAL")=$$GV^OCXOCMPE(OCXD0,OCXD1,"DFLD2",OCXOPDT,OCXNULL)
  1.  ;
  1.  I $D(OCXP("CLVAL")) D  I '$L(OCXP("CLVAL")) D WARN^OCXOCMPV("Comparison Value/Field minimum value not defined",3,OCXD0,$P($T(+1)," ",1)) Q ""
  1.  .S OCXP("CLVAL")=OCXITEM(3)
  1.  .I '$L(OCXP("CLVAL")) S OCXP("CLVAL")=$$GV^OCXOCMPE(OCXD0,OCXD1,"DFLD2",OCXOPDT,OCXNULL)
  1.  ;
  1.  I $D(OCXP("CHVAL")) D  I '$L(OCXP("CHVAL")) D WARN^OCXOCMPV("Comparison Value/Field maximum value not defined",3,OCXD0,$P($T(+1)," ",1)) Q ""
  1.  .S OCXP("CHVAL")=OCXITEM(5)
  1.  .I '$L(OCXP("CHVAL")) S OCXP("CHVAL")=$$GV^OCXOCMPE(OCXD0,OCXD1,"DFLD3",OCXOPDT,OCXNULL)
  1.  ;
  1.  S OCXCOD1="S OCXCODE=$$"_OCXP
  1.  I $O(OCXP(0)) S OCXCOD1=OCXCOD1_"(",OCXD2=0 F  S OCXD2=$O(OCXP(OCXD2)) Q:'OCXD2  D
  1.  .I ($E(OCXP(OCXP(OCXD2)),1)="""") S OCXCOD1=OCXCOD1_""""""_OCXP(OCXP(OCXD2))_""""""
  1.  .E  S OCXCOD1=OCXCOD1_""""_OCXP(OCXP(OCXD2))_""""
  1.  .I $O(OCXP(OCXD2)) S OCXCOD1=OCXCOD1_","
  1.  .E  S OCXCOD1=OCXCOD1_")"
  1.  X OCXCOD1
  1.  I '$L(OCXCODE) D WARN^OCXOCMPV("Execute code missing for '"_OCXCOD1_"'",2,OCXD0,$P($T(+1)," ",1)) Q ""
  1.  S OCXCD="I "_OCXCODE_" D @@@@" Q OCXWARN
  1.  ;
  1. GETIEN(FILE,KEY) ;
  1.  ;
  1.  N IEN1,IEN2,LEN,SHORT
  1.  F LEN=$L(KEY):-1:0 I LEN Q:$D(@FILE@("B",$E(KEY,1,LEN)))
  1.  Q:'LEN 0 S SHORT=$E(KEY,1,LEN)
  1.  S IEN1=0 F  S IEN1=$O(@FILE@("B",SHORT,IEN1)) Q:'IEN1  Q:($P($G(@FILE@(IEN1,0)),U,1)=KEY)
  1.  S IEN2=IEN1 F  S IEN2=$O(@FILE@("B",SHORT,IEN2)) Q:'IEN2  Q:($P($G(@FILE@(IEN2,0)),U,1)=KEY)
  1.  I IEN1,IEN2 Q -1
  1.  Q IEN1
  1.  ;
  1. OPER(OPER,DTYP) ;
  1.  ;
  1.  N DTYPN,OPERN
  1.  S DTYPN=$O(^OCXS(864.1,"B",DTYP,0)) Q:'DTYPN 0
  1.  S OPERN=0 F  S OPERN=$O(^OCXS(863.9,"B",OPER,OPERN)) Q:'OPERN  Q:($P($G(^OCXS(863.9,+OPERN,0)),U,2)=DTYPN)
  1.  Q:OPERN OPERN
  1.  S OPERN=0 F  S OPERN=$O(^OCXS(863.9,"SYN",OPER,OPERN)) Q:'OPERN  Q:($P($G(^OCXS(863.9,+OPERN,0)),U,2)=DTYPN)
  1.  Q OPERN
  1.  ;
  1. GETPARM(FILE,INST,PARM) ;
  1.  Q:'$L(FILE) "" Q:'$L(INST) "" Q:'$L(PARM) ""
  1.  N OCXP,OCXP1,OCXI,OCXGL
  1.  S OCXGL="^OCXS" S:(FILE=1) OCXGL="^OCXD" S:(FILE=7) OCXGL="^OCXD" S:(FILE=10) OCXGL="^OCXD" S FILE=FILE/10+860
  1.  Q:'$D(@OCXGL@(+FILE,0)) ""
  1.  I (PARM=+PARM),$D(^OCXS(863.8,PARM,0)) S OCXP=PARM
  1.  E  S OCXP=$O(^OCXS(863.8,"B",PARM,0))
  1.  Q:'OCXP ""
  1.  I (INST=+INST),$D(@OCXGL@(FILE,INST,0)) S OCXI=INST
  1.  E  S OCXI=$O(@OCXGL@(FILE,"B",INST,0))
  1.  Q:'OCXI ""
  1.  S OCXP1=$O(@OCXGL@(FILE,OCXI,"PAR","B",OCXP,0)) S:'OCXP1 OCXP1=$O(@OCXGL@(FILE,OCXI,"PAR","B",PARM,0))
  1.  Q:'$L(OCXP1) ""
  1.  Q $G(@OCXGL@(FILE,OCXI,"PAR",OCXP1,"VAL"))
  1. STSPAC(S) ;
  1.  ;
  1.  N X
  1.  ;
  1.  F X=1:1:$L(S) Q:'($E(S,X)=" ")
  1.  S S=$E(S,X,$L(S))
  1.  ;
  1.  F X=$L(S):-1:1 Q:'($E(S,X)=" ")
  1.  S S=$E(S,1,X)
  1.  ;
  1.  Q S
  1.  ;