142 lines
6.9 KiB
Mathematica
142 lines
6.9 KiB
Mathematica
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
|
|
;
|