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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOCXOCMP9 7175 printed Dec 13, 2024@02:24:46 Page 2
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
+2 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
+3 ;
+4 QUIT
EN() ;
+1 if $GET(OCXWARN)
QUIT 1
+2 ;
+3 SET OCXDLK=$ORDER(^OCXS(860.6,"B","DATABASE LOOKUP",0))
+4 ;
+5 NEW RESCAN
+6 ;
+7 SET OCXD0=0
FOR
SET OCXD0=$ORDER(^OCXS(860.2,OCXD0))
if 'OCXD0
QUIT
Begin DoDot:1
+8 if $GET(^OCXS(860.2,OCXD0,"INACT"))
QUIT
+9 IF '$GET(OCXAUTO)
if ($X>60)
WRITE !
WRITE "."
+10 SET ^TMP("OCXCMP",$JOB,"RULE",OCXD0)=""
+11 SET OCXD1=0
FOR
SET OCXD1=$ORDER(^OCXS(860.2,OCXD0,"C",OCXD1))
if 'OCXD1
QUIT
Begin DoDot:2
+12 NEW OCXEL,OCXEXP
+13 SET OCXEL=+$PIECE($GET(^OCXS(860.2,OCXD0,"C",OCXD1,0)),U,2)
IF OCXEL
IF $DATA(^OCXS(860.3,OCXEL,0))
Begin DoDot:3
+14 IF '$GET(OCXAUTO)
if ($X>60)
WRITE !
WRITE "."
+15 SET ^TMP("OCXCMP",$JOB,"ELEMENT",OCXEL)=$GET(^TMP("OCXCMP",$JOB,"ELEMENT",OCXEL))+1
+16 SET ^TMP("OCXCMP",$JOB,"ELEMENT",OCXEL,"CON")=+$PIECE($GET(^OCXS(860.3,OCXEL,0)),U,2)
End DoDot:3
+17 SET OCXEXP=$GET(^OCXS(860.2,OCXD0,"C",OCXD1,"EXP"))
IF $LENGTH(OCXEXP)
DO GETDF(OCXD0,OCXEXP,OCXEL,0,"EXP")
if OCXWARN
QUIT
+18 SET OCXEXP=$GET(^OCXS(860.2,OCXD0,"C",OCXD1,"SEL"))
IF $LENGTH(OCXEXP)
DO GETDF(OCXD0,OCXEXP,OCXEL,1,"SEL")
if OCXWARN
QUIT
End DoDot:2
if OCXWARN
QUIT
+19 if OCXWARN
QUIT
+20 SET OCXD1=0
FOR
SET OCXD1=$ORDER(^OCXS(860.2,OCXD0,"R",OCXD1))
if 'OCXD1
QUIT
Begin DoDot:2
+21 NEW OCXEXP
+22 SET OCXEXP=$GET(^OCXS(860.2,OCXD0,"R",OCXD1,"E"))
IF $LENGTH(OCXEXP)
DO GETDF(OCXD0,OCXEXP,0,0,"REL")
if OCXWARN
QUIT
+23 SET OCXEXP=$GET(^OCXS(860.2,OCXD0,"R",OCXD1,"MSG"))
IF $LENGTH(OCXEXP)
DO GETDF(OCXD0,OCXEXP,0,0,"MSG")
if OCXWARN
QUIT
+24 SET OCXEXP=$GET(^OCXS(860.2,OCXD0,"R",OCXD1,"OCMSG"))
IF $LENGTH(OCXEXP)
DO GETDF(OCXD0,OCXEXP,0,0,"MSG")
if OCXWARN
QUIT
+25 SET OCXEXP=$GET(^OCXS(860.2,OCXD0,"R",OCXD1,"RULE"))
IF $LENGTH(OCXEXP)
DO GETDF(OCXD0,OCXEXP,0,0,"MSG")
if OCXWARN
QUIT
+26 SET OCXEXP=$GET(^OCXS(860.2,OCXD0,"R",OCXD1,"MCODE"))
IF $LENGTH(OCXEXP)
DO GETDF(OCXD0,OCXEXP,0,0,"MCODE")
if OCXWARN
QUIT
End DoDot:2
if OCXWARN
QUIT
End DoDot:1
+27 ;
+28 SET OCXD1=0
FOR
SET OCXD1=$ORDER(^TMP("OCXCMP",$JOB,"ELEMENT",OCXD1))
if 'OCXD1
QUIT
Begin DoDot:1
+29 SET OCXD2=0
FOR
SET OCXD2=$ORDER(^OCXS(860.3,OCXD1,"COND",OCXD2))
if 'OCXD2
QUIT
Begin DoDot:2
+30 FOR OCXSUB=1,2,3
SET OCXDF=+$GET(^OCXS(860.3,OCXD1,"COND",OCXD2,"DFLD"_OCXSUB))
IF OCXDF
IF $DATA(^OCXS(860.4,OCXDF,0))
Begin DoDot:3
+31 IF '$GET(OCXAUTO)
if ($X>60)
WRITE !
WRITE "."
+32 SET ^TMP("OCXCMP",$JOB,"DATA FIELD",OCXDF)=$GET(^TMP("OCXCMP",$JOB,"DATA FIELD",OCXDF))+1
End DoDot:3
if OCXWARN
QUIT
End DoDot:2
if OCXWARN
QUIT
End DoDot:1
if OCXWARN
QUIT
+33 ;
+34 IF $ORDER(^TMP("OCXCMP",$JOB,"RULE",0))
Begin DoDot:1
+35 NEW OCXDFN,OCXDF
+36 FOR OCXDFN="PATIENT IEN"
SET OCXDF=$ORDER(^OCXS(860.4,"B",OCXDFN,0))
Begin DoDot:2
+37 SET ^TMP("OCXCMP",$JOB,"DATA FIELD",OCXDF)=$GET(^TMP("OCXCMP",$JOB,"DATA FIELD",OCXDF))+1
End DoDot:2
End DoDot:1
+38 ;
+39 FOR
Begin DoDot:1
+40 SET (RESCAN,OCXD1)=0
FOR
SET OCXD1=$ORDER(^TMP("OCXCMP",$JOB,"DATA FIELD",OCXD1))
if 'OCXD1
QUIT
Begin DoDot:2
+41 NEW OCXPATH,OCXLINK,OCXPAR,OCXVAL,OCXCON
+42 SET OCXCON=0
FOR
SET OCXCON=$ORDER(^OCXS(860.4,OCXD1,"LINK",OCXCON))
if 'OCXCON
QUIT
Begin DoDot:3
+43 SET OCXPATH=$GET(^OCXS(860.4,OCXD1,"LINK",OCXCON,"DATAPATH"))
if '$LENGTH(OCXPATH)
QUIT
+44 SET OCXLINK=$ORDER(^OCXS(863.3,"B",OCXPATH,0))
if 'OCXLINK
QUIT
+45 SET OCXPAR=0
FOR
SET OCXPAR=$ORDER(^OCXS(863.3,OCXLINK,"PAR",OCXPAR))
if 'OCXPAR
QUIT
SET OCXVAL=$GET(^(OCXPAR,"VAL"))
Begin DoDot:4
+46 if '(OCXVAL["|")
QUIT
+47 NEW OCXPIEC
+48 FOR OCXPIEC=2:2:$LENGTH(OCXVAL,"|")
Begin DoDot:5
+49 NEW OCXDF,OCXDFN
+50 SET OCXDF=$PIECE(OCXVAL,"|",OCXPIEC)
if '$LENGTH(OCXDF)
QUIT
+51 SET OCXDFN=0
FOR
SET OCXDFN=$ORDER(^OCXS(860.4,"B",$EXTRACT(OCXDF,1,30),OCXDFN))
if 'OCXDFN
QUIT
IF ($PIECE($GET(^OCXS(860.4,OCXDFN,0)),U,1)=OCXDF)
Begin DoDot:6
+52 IF '$DATA(^TMP("OCXCMP",$JOB,"DATA FIELD",OCXDFN))
SET RESCAN=1
SET ^TMP("OCXCMP",$JOB,"DATA FIELD",OCXDFN)=0
End DoDot:6
+53 SET OCXDFN=0
FOR
SET OCXDFN=$ORDER(^OCXS(860.4,"C",OCXDF,OCXDFN))
if 'OCXDFN
QUIT
Begin DoDot:6
+54 IF '$DATA(^TMP("OCXCMP",$JOB,"DATA FIELD",OCXDFN))
SET RESCAN=1
SET ^TMP("OCXCMP",$JOB,"DATA FIELD",OCXDFN)=0
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
if 'RESCAN
QUIT
+55 ;
+56 if $GET(OCXWARN)
QUIT 1
QUIT '$ORDER(^TMP("OCXCMP",$JOB,"RULE",0))
+57 ;
GETDF(OCXD0,OCXSTR,OCXELM,OCXREF,OCXSRC) ;
+1 ;
+2 NEW OCXPC,OCXFLD,OCXCON,OCXLABL,OCXDF,OCXFSPEC,OCXD1
+3 if '(OCXSTR["|")
QUIT
+4 FOR OCXPC=2:2:$LENGTH(OCXSTR,"|")
Begin DoDot:1
+5 SET OCXFSPEC=$PIECE($PIECE(OCXSTR,"|",OCXPC),"|",1)
SET (OCXFLD,OCXLABL)=""
+6 IF (OCXFSPEC[".")
Begin DoDot:2
+7 IF OCXELM
IF (OCXSRC="SEL")
DO WARN^OCXOCMPV(" '"_OCXFSPEC_"' cannot specify Label in selector.",2,OCXD0)
QUIT
+8 SET OCXLABL=$PIECE(OCXFSPEC,".",1)
SET OCXFLD=$PIECE(OCXFSPEC,".",2)
+9 IF '$LENGTH(OCXLABL)!'$LENGTH(OCXFLD)!($LENGTH(OCXFSPEC,".")>2)
Begin DoDot:3
+10 DO WARN^OCXOCMPV(" Illegal use of period '.' in Field Specifier '"_OCXFSPEC_"'",2,OCXD0,$PIECE($TEXT(+1)," ",1))
QUIT
End DoDot:3
QUIT
+11 SET OCXELE=+$PIECE($$LABEL(OCXD0,OCXLABL),U,2)
IF 'OCXELE
DO WARN^OCXOCMPV(" Label '"_OCXLABL_"' not defined in this rule.",2,OCXD0,$PIECE($TEXT(+1)," ",1))
QUIT
+12 SET OCXCON=$$DATACON(+OCXELE)
+13 IF '$LENGTH(OCXCON)
DO WARN^OCXOCMPV(" Data context not defined for element '"_$PIECE(^OCXS(860.3,+OCXELE,0),U,1)_"'.",2,OCXD0,$PIECE($TEXT(+1)," ",1))
QUIT
+14 SET OCXDF=$$DATAFLD(OCXFLD,OCXCON)
+15 IF (OCXDF=-1)
DO WARN^OCXOCMPV(" "_OCXFLD_" data field name not unique.",2,OCXD0,$PIECE($TEXT(+1)," ",1))
QUIT
+16 IF (OCXDF=-2)
DO WARN^OCXOCMPV(" "_OCXFLD_" data field not in Data Field file.",2,OCXD0,$PIECE($TEXT(+1)," ",1))
QUIT
+17 IF 'OCXDF
SET OCXDF=$$DATAFLD(OCXFLD,OCXDLK)
+18 IF 'OCXDF
DO WARN^OCXOCMPV(" "_OCXFLD_" data field not defined for "_OCXCON_" data context.",2,OCXD0,$PIECE($TEXT(+1)," ",1))
QUIT
+19 IF '$GET(OCXAUTO)
if ($X>60)
WRITE !
WRITE "."
+20 SET ^TMP("OCXCMP",$JOB,"ELEMENT",OCXELE,"DATA",OCXDF)=OCXREF
+21 IF '$DATA(^TMP("OCXCMP",$JOB,"DATA FIELD",OCXDF))
Begin DoDot:3
+22 IF '$GET(OCXAUTO)
if ($X>60)
WRITE !
WRITE "."
+23 SET ^TMP("OCXCMP",$JOB,"DATA FIELD",OCXDF)=1
End DoDot:3
End DoDot:2
QUIT
+24 ;
+25 IF OCXELM
Begin DoDot:2
+26 SET OCXFLD=OCXFSPEC
SET OCXDF=0
+27 SET OCXCON=$$DATACON(+OCXELM)
if '$LENGTH(OCXCON)
QUIT
+28 SET OCXDF=$$DATAFLD(OCXFLD,OCXCON)
+29 IF (OCXDF=-1)
DO WARN^OCXOCMPV(" "_OCXFLD_" data field name not unique.",2,OCXD0,$PIECE($TEXT(+1)," ",1))
QUIT
+30 IF (OCXDF=-2)
DO WARN^OCXOCMPV(" "_OCXFLD_" data field not in Data Field file.",2,OCXD0,$PIECE($TEXT(+1)," ",1))
QUIT
+31 IF 'OCXDF
SET OCXDF=$$DATAFLD(OCXFLD,OCXDLK)
+32 IF 'OCXDF
DO WARN^OCXOCMPV(" "_OCXFLD_" data field not defined for "_OCXCON_" data context.",2,OCXD0,$PIECE($TEXT(+1)," ",1))
QUIT
+33 IF '$GET(OCXAUTO)
if ($X>60)
WRITE !
WRITE "."
+34 SET ^TMP("OCXCMP",$JOB,"ELEMENT",OCXELM,"DATA",OCXDF)=OCXREF
+35 IF '$DATA(^TMP("OCXCMP",$JOB,"DATA FIELD",OCXDF))
Begin DoDot:3
+36 IF '$GET(OCXAUTO)
if ($X>60)
WRITE !
WRITE "."
+37 SET ^TMP("OCXCMP",$JOB,"DATA FIELD",OCXDF)=1
End DoDot:3
End DoDot:2
QUIT
+38 ;
+39 SET OCXFLD=OCXFSPEC
SET OCXDF=0
+40 SET OCXD1=0
FOR
SET OCXD1=$ORDER(^OCXS(860.2,OCXD0,"C",OCXD1))
if 'OCXD1
QUIT
Begin DoDot:2
+41 SET OCXELE=+$PIECE($GET(^OCXS(860.2,OCXD0,"C",OCXD1,0)),U,2)
if 'OCXELE
QUIT
+42 SET OCXCON=$$DATACON(+OCXELE)
if '$LENGTH(OCXCON)
QUIT
+43 SET OCXDF=$$DATAFLD(OCXFLD,OCXCON)
+44 IF (OCXDF=-1)
DO WARN^OCXOCMPV(" "_OCXFLD_" data field name not unique.",2,OCXD0,$PIECE($TEXT(+1)," ",1))
QUIT
+45 IF (OCXDF=-2)
DO WARN^OCXOCMPV(" "_OCXFLD_" data field not in Data Field file.",2,OCXD0,$PIECE($TEXT(+1)," ",1))
QUIT
+46 if 'OCXDF
SET OCXDF=$$DATAFLD(OCXFLD,OCXDLK)
+47 if 'OCXDF
QUIT
+48 ;
+49 IF '$GET(OCXAUTO)
if ($X>60)
WRITE !
WRITE "."
+50 SET ^TMP("OCXCMP",$JOB,"ELEMENT",OCXELE,"DATA",OCXDF)=OCXREF
+51 IF '$DATA(^TMP("OCXCMP",$JOB,"DATA FIELD",OCXDF))
Begin DoDot:3
+52 IF '$GET(OCXAUTO)
if ($X>60)
WRITE !
WRITE "."
+53 SET ^TMP("OCXCMP",$JOB,"DATA FIELD",OCXDF)=1
End DoDot:3
End DoDot:2
End DoDot:1
if OCXWARN
QUIT
+54 QUIT
+55 ;
DATACON(OCXEL) ;
+1 ;
+2 QUIT +$PIECE($GET(^OCXS(860.3,OCXEL,0)),U,2)
+3 ;
LABEL(OCXD0,OCXLABL) ;
+1 ;
+2 NEW OCXEL
+3 if '$LENGTH(OCXLABL)
QUIT 0
SET OCXEL=+$ORDER(^OCXS(860.2,OCXD0,"C","B",OCXLABL,0))
if 'OCXEL
QUIT 0
+4 QUIT (+OCXEL)_U_+$PIECE($GET(^OCXS(860.2,OCXD0,"C",OCXEL,0)),U,2)
+5 ;
DATAFLD(FNAM,CONTXT) ;
+1 ;
+2 NEW FNUM,D0
+3 if '$GET(CONTXT)
QUIT 0
+4 SET FNUM=$ORDER(^OCXS(860.4,"C",FNAM,0))
+5 IF 'FNUM
SET FNUM=0
FOR
SET FNUM=$ORDER(^OCXS(860.4,"B",$EXTRACT(FNAM,1,30),FNUM))
if 'FNUM
QUIT
if ($PIECE($GET(^OCXS(860.4,FNUM,0)),U,1)=FNAM)
QUIT
+6 IF 'FNUM
QUIT -2
+7 ;
+8 if $ORDER(^OCXS(860.4,"B",FNAM,FNUM))
QUIT -1
+9 if $LENGTH($GET(^OCXS(860.4,FNUM,"LINK",CONTXT,"DATAPATH")))
QUIT FNUM
+10 QUIT 0
+11 ;
