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