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

OCXOCMPE.m

Go to the documentation of this file.
  1. OCXOCMPE ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Compile Rule Elements cont...) ;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,OCXD1,OCXP) ;
  1. ;
  1. N OCXNULL
  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")=$$GV(OCXD0,OCXD1,"DFLD1",OCXOPDT,OCXNULL)
  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")=$$GV(OCXD0,OCXD1,"VAL1",OCXOPDT,OCXNULL)
  1. .I '$L(OCXP("CVAL")) S OCXP("CVAL")=$$GV(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")=$$GV(OCXD0,OCXD1,"VAL1",OCXOPDT,OCXNULL)
  1. .I '$L(OCXP("CLVAL")) S OCXP("CLVAL")=$$GV(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")=$$GV(OCXD0,OCXD1,"VAL2",OCXOPDT,OCXNULL)
  1. .I '$L(OCXP("CHVAL")) S OCXP("CHVAL")=$$GV(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. I OCXTLOG,(OCXCODE["$$") D FILECODE("S OCXBOOLV="_OCXCODE,"S"),FILECODE("I OCXBOOLV","I") I 1
  1. E D FILECODE("I "_OCXCODE,"I")
  1. Q
  1. ;
  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. ;
  1. GV(D0,D1,SUB,DTYP,NULL) ;
  1. ;
  1. N OCXVAL,OCXFLDN,OCXFLDG,OCXD2,OCXCON,OCXCONN,OCXFREC
  1. ;
  1. S OCXVAL=$G(^OCXS(860.3,D0,"COND",D1,SUB)) Q:'$L(OCXVAL) ""
  1. Q:(SUB["VAL") $$EXT2INT^OCXOCMPA($P($G(^OCXS(864.1,+DTYP,0)),U,1),OCXVAL)
  1. ;
  1. S OCXVAL=+OCXVAL,OCXFLDN=$P($G(^OCXS(860.4,OCXVAL,0)),U,1),OCXCON=$P($G(^OCXS(860.3,+D0,0)),U,2)
  1. I 'OCXCON D WARN^OCXOCMPV("Element context missing for '"_$P($G(^OCXS(860.3,D0,0)),U,1)_"'",3,D0,$P($T(+1)," ",1)) Q
  1. I '$L(OCXFLDN) D WARN^OCXOCMPV("Data Field Name missing for '"_OCXDFLD_"'",3,D0,$P($T(+1)," ",1)) Q
  1. S OCXFREC="" I $D(^TMP("OCXCMP",$J,"DATA FIELD",OCXVAL)) M OCXFREC=^TMP("OCXCMP",$J,"DATA FIELD",OCXVAL)
  1. I '$O(OCXFREC(0)) D Q ""
  1. .D WARN^OCXOCMPV("CMPE Get data code not defined for '"_OCXFLDN_"' ("_(+OCXVAL)_")",3,D0,$P($T(+1)," ",1)) Q
  1. ;
  1. I '$D(OCXFREC(OCXCON)) D
  1. .S OCXCONN=0 F S OCXCONN=$O(OCXFREC(OCXCONN)) Q:'OCXCONN Q:$G(OCXFREC(OCXCONN,"DA MODE"))
  1. .I 'OCXCONN D WARN^OCXOCMPV("CMPE Get data code mising for '"_$P($G(^OCXS(860.6,+OCXCON,0)),U,1)_"' ("_(+OCXCON)_") context of field '"_OCXFLDN_"' ("_(+OCXVAL)_")",3,D0,$P($T(+1)," ",1))
  1. .S OCXCON=+OCXCONN
  1. Q:'OCXCON ""
  1. ;
  1. I '$L($G(OCXFREC(OCXCON,"DTYP","DATA TYPE INDEX")))!'$L($G(OCXFREC(OCXCON,"DTYP","DATA TYPE NAME"))) D Q ""
  1. .D WARN^OCXOCMPV("Data Type not defined for '"_OCXFLDN_"' Field",3,D0,$P($T(+1)," ",1)) Q
  1. I '(+DTYP=$G(OCXFREC(OCXCON,"DTYP","DATA TYPE INDEX"))) D Q ""
  1. .N OCXX S OCXX="'"_OCXVAL_"-"_OCXFLDN_"' field's Data Type '"_OCXFREC(OCXCON,"DTYP","DATA TYPE NAME")
  1. .S OCXX=OCXX_"' is not valid for '"_OCXOPN_"' Operator ("_(+DTYP)_"-"_$P($G(^OCXS(864.1,+DTYP,0)),U,1)_")"
  1. .D WARN^OCXOCMPV(OCXX,3,D0,$P($T(+1)," ",1)) Q
  1. ;
  1. S OCXFLDG="OCXDF("_(+OCXVAL)_")"
  1. ;
  1. I 'NULL D FILECODE("I $L("_OCXFLDG_")","I")
  1. ;
  1. Q OCXFLDG
  1. K D0,D1
  1. ;
  1. FILECODE(CODE,OPLIST) ;
  1. ;
  1. N OCXNDX S OCXNDX=$O(OCXFCODE(9999),-1)+1,OCXFCODE(OCXNDX)=CODE
  1. S:$L($G(OPLIST)) OCXFCODE(OCXNDX,"OPLIST")=OPLIST
  1. Q