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

OCXOCMP9.m

Go to the documentation of this file. 
  1. OCXOCMP9 ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Build List of Active Rules, Elements and Data Fields) ;3/27/01  07:29
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,105**;Dec 17,1997
  1.  ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
  1.  ;
  1.  Q
  1. EN() ;
  1.  Q:$G(OCXWARN) 1
  1.  ;
  1.  S OCXDLK=$O(^OCXS(860.6,"B","DATABASE LOOKUP",0))
  1.  ;
  1.  N RESCAN
  1.  ;
  1.  S OCXD0=0 F  S OCXD0=$O(^OCXS(860.2,OCXD0)) Q:'OCXD0  D
  1.  .Q:$G(^OCXS(860.2,OCXD0,"INACT"))
  1.  .I '$G(OCXAUTO) W:($X>60) ! W "."
  1.  .S ^TMP("OCXCMP",$J,"RULE",OCXD0)=""
  1.  .S OCXD1=0 F  S OCXD1=$O(^OCXS(860.2,OCXD0,"C",OCXD1)) Q:'OCXD1  D  Q:OCXWARN
  1.  ..N OCXEL,OCXEXP
  1.  ..S OCXEL=+$P($G(^OCXS(860.2,OCXD0,"C",OCXD1,0)),U,2) I OCXEL,$D(^OCXS(860.3,OCXEL,0)) D
  1.  ...I '$G(OCXAUTO) W:($X>60) ! W "."
  1.  ...S ^TMP("OCXCMP",$J,"ELEMENT",OCXEL)=$G(^TMP("OCXCMP",$J,"ELEMENT",OCXEL))+1
  1.  ...S ^TMP("OCXCMP",$J,"ELEMENT",OCXEL,"CON")=+$P($G(^OCXS(860.3,OCXEL,0)),U,2)
  1.  ..S OCXEXP=$G(^OCXS(860.2,OCXD0,"C",OCXD1,"EXP")) I $L(OCXEXP)  D GETDF(OCXD0,OCXEXP,OCXEL,0,"EXP") Q:OCXWARN
  1.  ..S OCXEXP=$G(^OCXS(860.2,OCXD0,"C",OCXD1,"SEL")) I $L(OCXEXP)  D GETDF(OCXD0,OCXEXP,OCXEL,1,"SEL") Q:OCXWARN
  1.  .Q:OCXWARN
  1.  .S OCXD1=0 F  S OCXD1=$O(^OCXS(860.2,OCXD0,"R",OCXD1)) Q:'OCXD1  D  Q:OCXWARN
  1.  ..N OCXEXP
  1.  ..S OCXEXP=$G(^OCXS(860.2,OCXD0,"R",OCXD1,"E")) I $L(OCXEXP)  D GETDF(OCXD0,OCXEXP,0,0,"REL") Q:OCXWARN
  1.  ..S OCXEXP=$G(^OCXS(860.2,OCXD0,"R",OCXD1,"MSG")) I $L(OCXEXP)  D GETDF(OCXD0,OCXEXP,0,0,"MSG") Q:OCXWARN
  1.  ..S OCXEXP=$G(^OCXS(860.2,OCXD0,"R",OCXD1,"OCMSG")) I $L(OCXEXP)  D GETDF(OCXD0,OCXEXP,0,0,"MSG") Q:OCXWARN
  1.  ..S OCXEXP=$G(^OCXS(860.2,OCXD0,"R",OCXD1,"RULE")) I $L(OCXEXP)  D GETDF(OCXD0,OCXEXP,0,0,"MSG") Q:OCXWARN
  1.  ..S OCXEXP=$G(^OCXS(860.2,OCXD0,"R",OCXD1,"MCODE")) I $L(OCXEXP)  D GETDF(OCXD0,OCXEXP,0,0,"MCODE") Q:OCXWARN
  1.  ;
  1.  S OCXD1=0 F  S OCXD1=$O(^TMP("OCXCMP",$J,"ELEMENT",OCXD1)) Q:'OCXD1  D  Q:OCXWARN
  1.  .S OCXD2=0 F  S OCXD2=$O(^OCXS(860.3,OCXD1,"COND",OCXD2)) Q:'OCXD2  D  Q:OCXWARN
  1.  ..F OCXSUB=1,2,3 S OCXDF=+$G(^OCXS(860.3,OCXD1,"COND",OCXD2,"DFLD"_OCXSUB)) I OCXDF,$D(^OCXS(860.4,OCXDF,0)) D  Q:OCXWARN
  1.  ...I '$G(OCXAUTO) W:($X>60) ! W "."
  1.  ...S ^TMP("OCXCMP",$J,"DATA FIELD",OCXDF)=$G(^TMP("OCXCMP",$J,"DATA FIELD",OCXDF))+1
  1.  ;
  1.  I $O(^TMP("OCXCMP",$J,"RULE",0)) D
  1.  .N OCXDFN,OCXDF
  1.  .F OCXDFN="PATIENT IEN" S OCXDF=$O(^OCXS(860.4,"B",OCXDFN,0)) D
  1.  ..S ^TMP("OCXCMP",$J,"DATA FIELD",OCXDF)=$G(^TMP("OCXCMP",$J,"DATA FIELD",OCXDF))+1
  1.  ;
  1.  F  D  Q:'RESCAN
  1.  .S (RESCAN,OCXD1)=0 F  S OCXD1=$O(^TMP("OCXCMP",$J,"DATA FIELD",OCXD1)) Q:'OCXD1  D
  1.  ..N OCXPATH,OCXLINK,OCXPAR,OCXVAL,OCXCON
  1.  ..S OCXCON=0 F  S OCXCON=$O(^OCXS(860.4,OCXD1,"LINK",OCXCON)) Q:'OCXCON  D
  1.  ...S OCXPATH=$G(^OCXS(860.4,OCXD1,"LINK",OCXCON,"DATAPATH")) Q:'$L(OCXPATH)
  1.  ...S OCXLINK=$O(^OCXS(863.3,"B",OCXPATH,0)) Q:'OCXLINK
  1.  ...S OCXPAR=0 F  S OCXPAR=$O(^OCXS(863.3,OCXLINK,"PAR",OCXPAR)) Q:'OCXPAR  S OCXVAL=$G(^(OCXPAR,"VAL")) D
  1.  ....Q:'(OCXVAL["|")
  1.  ....N OCXPIEC
  1.  ....F OCXPIEC=2:2:$L(OCXVAL,"|") D
  1.  .....N OCXDF,OCXDFN
  1.  .....S OCXDF=$P(OCXVAL,"|",OCXPIEC) Q:'$L(OCXDF)
  1.  .....S OCXDFN=0 F  S OCXDFN=$O(^OCXS(860.4,"B",$E(OCXDF,1,30),OCXDFN)) Q:'OCXDFN  I ($P($G(^OCXS(860.4,OCXDFN,0)),U,1)=OCXDF) D
  1.  ......I '$D(^TMP("OCXCMP",$J,"DATA FIELD",OCXDFN)) S RESCAN=1,^TMP("OCXCMP",$J,"DATA FIELD",OCXDFN)=0
  1.  .....S OCXDFN=0 F  S OCXDFN=$O(^OCXS(860.4,"C",OCXDF,OCXDFN)) Q:'OCXDFN  D
  1.  ......I '$D(^TMP("OCXCMP",$J,"DATA FIELD",OCXDFN)) S RESCAN=1,^TMP("OCXCMP",$J,"DATA FIELD",OCXDFN)=0
  1.  ;
  1.  Q:$G(OCXWARN) 1 Q '$O(^TMP("OCXCMP",$J,"RULE",0))
  1.  ;
  1. GETDF(OCXD0,OCXSTR,OCXELM,OCXREF,OCXSRC) ;
  1.  ;
  1.  N OCXPC,OCXFLD,OCXCON,OCXLABL,OCXDF,OCXFSPEC,OCXD1
  1.  Q:'(OCXSTR["|")
  1.  F OCXPC=2:2:$L(OCXSTR,"|") D  Q:OCXWARN
  1.  .S OCXFSPEC=$P($P(OCXSTR,"|",OCXPC),"|",1),(OCXFLD,OCXLABL)=""
  1.  .I (OCXFSPEC[".") D  Q
  1.  ..I OCXELM,(OCXSRC="SEL") D WARN^OCXOCMPV(" '"_OCXFSPEC_"'   cannot specify Label in selector.",2,OCXD0) Q
  1.  ..S OCXLABL=$P(OCXFSPEC,".",1),OCXFLD=$P(OCXFSPEC,".",2)
  1.  ..I '$L(OCXLABL)!'$L(OCXFLD)!($L(OCXFSPEC,".")>2) D  Q
  1.  ...D WARN^OCXOCMPV(" Illegal use of period '.' in Field Specifier '"_OCXFSPEC_"'",2,OCXD0,$P($T(+1)," ",1)) Q
  1.  ..S OCXELE=+$P($$LABEL(OCXD0,OCXLABL),U,2) I 'OCXELE D WARN^OCXOCMPV(" Label '"_OCXLABL_"' not defined in this rule.",2,OCXD0,$P($T(+1)," ",1)) Q
  1.  ..S OCXCON=$$DATACON(+OCXELE)
  1.  ..I '$L(OCXCON) D WARN^OCXOCMPV(" Data context not defined for element '"_$P(^OCXS(860.3,+OCXELE,0),U,1)_"'.",2,OCXD0,$P($T(+1)," ",1)) Q
  1.  ..S OCXDF=$$DATAFLD(OCXFLD,OCXCON)
  1.  ..I (OCXDF=-1) D WARN^OCXOCMPV(" "_OCXFLD_" data field name not unique.",2,OCXD0,$P($T(+1)," ",1)) Q
  1.  ..I (OCXDF=-2) D WARN^OCXOCMPV(" "_OCXFLD_" data field not in Data Field file.",2,OCXD0,$P($T(+1)," ",1)) Q
  1.  ..I 'OCXDF S OCXDF=$$DATAFLD(OCXFLD,OCXDLK)
  1.  ..I 'OCXDF D WARN^OCXOCMPV(" "_OCXFLD_" data field not defined for "_OCXCON_" data context.",2,OCXD0,$P($T(+1)," ",1)) Q
  1.  ..I '$G(OCXAUTO) W:($X>60) ! W "."
  1.  ..S ^TMP("OCXCMP",$J,"ELEMENT",OCXELE,"DATA",OCXDF)=OCXREF
  1.  ..I '$D(^TMP("OCXCMP",$J,"DATA FIELD",OCXDF)) D
  1.  ...I '$G(OCXAUTO) W:($X>60) ! W "."
  1.  ...S ^TMP("OCXCMP",$J,"DATA FIELD",OCXDF)=1
  1.  .;
  1.  .I OCXELM D  Q
  1.  ..S OCXFLD=OCXFSPEC,OCXDF=0
  1.  ..S OCXCON=$$DATACON(+OCXELM) Q:'$L(OCXCON)
  1.  ..S OCXDF=$$DATAFLD(OCXFLD,OCXCON)
  1.  ..I (OCXDF=-1) D WARN^OCXOCMPV(" "_OCXFLD_" data field name not unique.",2,OCXD0,$P($T(+1)," ",1)) Q
  1.  ..I (OCXDF=-2) D WARN^OCXOCMPV(" "_OCXFLD_" data field not in Data Field file.",2,OCXD0,$P($T(+1)," ",1)) Q
  1.  ..I 'OCXDF S OCXDF=$$DATAFLD(OCXFLD,OCXDLK)
  1.  ..I 'OCXDF D WARN^OCXOCMPV(" "_OCXFLD_" data field not defined for "_OCXCON_" data context.",2,OCXD0,$P($T(+1)," ",1)) Q
  1.  ..I '$G(OCXAUTO) W:($X>60) ! W "."
  1.  ..S ^TMP("OCXCMP",$J,"ELEMENT",OCXELM,"DATA",OCXDF)=OCXREF
  1.  ..I '$D(^TMP("OCXCMP",$J,"DATA FIELD",OCXDF)) D
  1.  ...I '$G(OCXAUTO) W:($X>60) ! W "."
  1.  ...S ^TMP("OCXCMP",$J,"DATA FIELD",OCXDF)=1
  1.  .;
  1.  .S OCXFLD=OCXFSPEC,OCXDF=0
  1.  .S OCXD1=0 F  S OCXD1=$O(^OCXS(860.2,OCXD0,"C",OCXD1)) Q:'OCXD1  D
  1.  ..S OCXELE=+$P($G(^OCXS(860.2,OCXD0,"C",OCXD1,0)),U,2) Q:'OCXELE
  1.  ..S OCXCON=$$DATACON(+OCXELE) Q:'$L(OCXCON)
  1.  ..S OCXDF=$$DATAFLD(OCXFLD,OCXCON)
  1.  ..I (OCXDF=-1) D WARN^OCXOCMPV(" "_OCXFLD_" data field name not unique.",2,OCXD0,$P($T(+1)," ",1)) Q
  1.  ..I (OCXDF=-2) D WARN^OCXOCMPV(" "_OCXFLD_" data field not in Data Field file.",2,OCXD0,$P($T(+1)," ",1)) Q
  1.  ..S:'OCXDF OCXDF=$$DATAFLD(OCXFLD,OCXDLK)
  1.  ..Q:'OCXDF
  1.  ..;
  1.  ..I '$G(OCXAUTO) W:($X>60) ! W "."
  1.  ..S ^TMP("OCXCMP",$J,"ELEMENT",OCXELE,"DATA",OCXDF)=OCXREF
  1.  ..I '$D(^TMP("OCXCMP",$J,"DATA FIELD",OCXDF)) D
  1.  ...I '$G(OCXAUTO) W:($X>60) ! W "."
  1.  ...S ^TMP("OCXCMP",$J,"DATA FIELD",OCXDF)=1
  1.  Q
  1.  ;
  1. DATACON(OCXEL) ;
  1.  ;
  1.  Q +$P($G(^OCXS(860.3,OCXEL,0)),U,2)
  1.  ;
  1. LABEL(OCXD0,OCXLABL) ;
  1.  ;
  1.  N OCXEL
  1.  Q:'$L(OCXLABL) 0 S OCXEL=+$O(^OCXS(860.2,OCXD0,"C","B",OCXLABL,0)) Q:'OCXEL 0
  1.  Q (+OCXEL)_U_+$P($G(^OCXS(860.2,OCXD0,"C",OCXEL,0)),U,2)
  1.  ;
  1. DATAFLD(FNAM,CONTXT) ;
  1.  ;
  1.  N FNUM,D0
  1.  Q:'$G(CONTXT) 0
  1.  S FNUM=$O(^OCXS(860.4,"C",FNAM,0))
  1.  I 'FNUM S FNUM=0 F  S FNUM=$O(^OCXS(860.4,"B",$E(FNAM,1,30),FNUM)) Q:'FNUM  Q:($P($G(^OCXS(860.4,FNUM,0)),U,1)=FNAM)
  1.  I 'FNUM Q -2
  1.  ;
  1.  Q:$O(^OCXS(860.4,"B",FNAM,FNUM)) -1
  1.  Q:$L($G(^OCXS(860.4,FNUM,"LINK",CONTXT,"DATAPATH"))) FNUM
  1.  Q 0
  1.  ;