source: FOIAVistA/tag/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXOCMP9.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.9 KB
Line 
1OCXOCMP9 ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Build List of Active Rules, Elements and Data Fields) ;3/27/01 07:29
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,105**;Dec 17,1997
3 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
4 ;
5 Q
6EN() ;
7 Q:$G(OCXWARN) 1
8 ;
9 S OCXDLK=$O(^OCXS(860.6,"B","DATABASE LOOKUP",0))
10 ;
11 N RESCAN
12 ;
13 S OCXD0=0 F S OCXD0=$O(^OCXS(860.2,OCXD0)) Q:'OCXD0 D
14 .Q:$G(^OCXS(860.2,OCXD0,"INACT"))
15 .I '$G(OCXAUTO) W:($X>60) ! W "."
16 .S ^TMP("OCXCMP",$J,"RULE",OCXD0)=""
17 .S OCXD1=0 F S OCXD1=$O(^OCXS(860.2,OCXD0,"C",OCXD1)) Q:'OCXD1 D Q:OCXWARN
18 ..N OCXEL,OCXEXP
19 ..S OCXEL=+$P($G(^OCXS(860.2,OCXD0,"C",OCXD1,0)),U,2) I OCXEL,$D(^OCXS(860.3,OCXEL,0)) D
20 ...I '$G(OCXAUTO) W:($X>60) ! W "."
21 ...S ^TMP("OCXCMP",$J,"ELEMENT",OCXEL)=$G(^TMP("OCXCMP",$J,"ELEMENT",OCXEL))+1
22 ...S ^TMP("OCXCMP",$J,"ELEMENT",OCXEL,"CON")=+$P($G(^OCXS(860.3,OCXEL,0)),U,2)
23 ..S OCXEXP=$G(^OCXS(860.2,OCXD0,"C",OCXD1,"EXP")) I $L(OCXEXP) D GETDF(OCXD0,OCXEXP,OCXEL,0,"EXP") Q:OCXWARN
24 ..S OCXEXP=$G(^OCXS(860.2,OCXD0,"C",OCXD1,"SEL")) I $L(OCXEXP) D GETDF(OCXD0,OCXEXP,OCXEL,1,"SEL") Q:OCXWARN
25 .Q:OCXWARN
26 .S OCXD1=0 F S OCXD1=$O(^OCXS(860.2,OCXD0,"R",OCXD1)) Q:'OCXD1 D Q:OCXWARN
27 ..N OCXEXP
28 ..S OCXEXP=$G(^OCXS(860.2,OCXD0,"R",OCXD1,"E")) I $L(OCXEXP) D GETDF(OCXD0,OCXEXP,0,0,"REL") Q:OCXWARN
29 ..S OCXEXP=$G(^OCXS(860.2,OCXD0,"R",OCXD1,"MSG")) I $L(OCXEXP) D GETDF(OCXD0,OCXEXP,0,0,"MSG") Q:OCXWARN
30 ..S OCXEXP=$G(^OCXS(860.2,OCXD0,"R",OCXD1,"OCMSG")) I $L(OCXEXP) D GETDF(OCXD0,OCXEXP,0,0,"MSG") Q:OCXWARN
31 ..S OCXEXP=$G(^OCXS(860.2,OCXD0,"R",OCXD1,"RULE")) I $L(OCXEXP) D GETDF(OCXD0,OCXEXP,0,0,"MSG") Q:OCXWARN
32 ..S OCXEXP=$G(^OCXS(860.2,OCXD0,"R",OCXD1,"MCODE")) I $L(OCXEXP) D GETDF(OCXD0,OCXEXP,0,0,"MCODE") Q:OCXWARN
33 ;
34 S OCXD1=0 F S OCXD1=$O(^TMP("OCXCMP",$J,"ELEMENT",OCXD1)) Q:'OCXD1 D Q:OCXWARN
35 .S OCXD2=0 F S OCXD2=$O(^OCXS(860.3,OCXD1,"COND",OCXD2)) Q:'OCXD2 D Q:OCXWARN
36 ..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
37 ...I '$G(OCXAUTO) W:($X>60) ! W "."
38 ...S ^TMP("OCXCMP",$J,"DATA FIELD",OCXDF)=$G(^TMP("OCXCMP",$J,"DATA FIELD",OCXDF))+1
39 ;
40 I $O(^TMP("OCXCMP",$J,"RULE",0)) D
41 .N OCXDFN,OCXDF
42 .F OCXDFN="PATIENT IEN" S OCXDF=$O(^OCXS(860.4,"B",OCXDFN,0)) D
43 ..S ^TMP("OCXCMP",$J,"DATA FIELD",OCXDF)=$G(^TMP("OCXCMP",$J,"DATA FIELD",OCXDF))+1
44 ;
45 F D Q:'RESCAN
46 .S (RESCAN,OCXD1)=0 F S OCXD1=$O(^TMP("OCXCMP",$J,"DATA FIELD",OCXD1)) Q:'OCXD1 D
47 ..N OCXPATH,OCXLINK,OCXPAR,OCXVAL,OCXCON
48 ..S OCXCON=0 F S OCXCON=$O(^OCXS(860.4,OCXD1,"LINK",OCXCON)) Q:'OCXCON D
49 ...S OCXPATH=$G(^OCXS(860.4,OCXD1,"LINK",OCXCON,"DATAPATH")) Q:'$L(OCXPATH)
50 ...S OCXLINK=$O(^OCXS(863.3,"B",OCXPATH,0)) Q:'OCXLINK
51 ...S OCXPAR=0 F S OCXPAR=$O(^OCXS(863.3,OCXLINK,"PAR",OCXPAR)) Q:'OCXPAR S OCXVAL=$G(^(OCXPAR,"VAL")) D
52 ....Q:'(OCXVAL["|")
53 ....N OCXPIEC
54 ....F OCXPIEC=2:2:$L(OCXVAL,"|") D
55 .....N OCXDF,OCXDFN
56 .....S OCXDF=$P(OCXVAL,"|",OCXPIEC) Q:'$L(OCXDF)
57 .....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
58 ......I '$D(^TMP("OCXCMP",$J,"DATA FIELD",OCXDFN)) S RESCAN=1,^TMP("OCXCMP",$J,"DATA FIELD",OCXDFN)=0
59 .....S OCXDFN=0 F S OCXDFN=$O(^OCXS(860.4,"C",OCXDF,OCXDFN)) Q:'OCXDFN D
60 ......I '$D(^TMP("OCXCMP",$J,"DATA FIELD",OCXDFN)) S RESCAN=1,^TMP("OCXCMP",$J,"DATA FIELD",OCXDFN)=0
61 ;
62 Q:$G(OCXWARN) 1 Q '$O(^TMP("OCXCMP",$J,"RULE",0))
63 ;
64GETDF(OCXD0,OCXSTR,OCXELM,OCXREF,OCXSRC) ;
65 ;
66 N OCXPC,OCXFLD,OCXCON,OCXLABL,OCXDF,OCXFSPEC,OCXD1
67 Q:'(OCXSTR["|")
68 F OCXPC=2:2:$L(OCXSTR,"|") D Q:OCXWARN
69 .S OCXFSPEC=$P($P(OCXSTR,"|",OCXPC),"|",1),(OCXFLD,OCXLABL)=""
70 .I (OCXFSPEC[".") D Q
71 ..I OCXELM,(OCXSRC="SEL") D WARN^OCXOCMPV(" '"_OCXFSPEC_"' cannot specify Label in selector.",2,OCXD0) Q
72 ..S OCXLABL=$P(OCXFSPEC,".",1),OCXFLD=$P(OCXFSPEC,".",2)
73 ..I '$L(OCXLABL)!'$L(OCXFLD)!($L(OCXFSPEC,".")>2) D Q
74 ...D WARN^OCXOCMPV(" Illegal use of period '.' in Field Specifier '"_OCXFSPEC_"'",2,OCXD0,$P($T(+1)," ",1)) Q
75 ..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
76 ..S OCXCON=$$DATACON(+OCXELE)
77 ..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
78 ..S OCXDF=$$DATAFLD(OCXFLD,OCXCON)
79 ..I (OCXDF=-1) D WARN^OCXOCMPV(" "_OCXFLD_" data field name not unique.",2,OCXD0,$P($T(+1)," ",1)) Q
80 ..I (OCXDF=-2) D WARN^OCXOCMPV(" "_OCXFLD_" data field not in Data Field file.",2,OCXD0,$P($T(+1)," ",1)) Q
81 ..I 'OCXDF S OCXDF=$$DATAFLD(OCXFLD,OCXDLK)
82 ..I 'OCXDF D WARN^OCXOCMPV(" "_OCXFLD_" data field not defined for "_OCXCON_" data context.",2,OCXD0,$P($T(+1)," ",1)) Q
83 ..I '$G(OCXAUTO) W:($X>60) ! W "."
84 ..S ^TMP("OCXCMP",$J,"ELEMENT",OCXELE,"DATA",OCXDF)=OCXREF
85 ..I '$D(^TMP("OCXCMP",$J,"DATA FIELD",OCXDF)) D
86 ...I '$G(OCXAUTO) W:($X>60) ! W "."
87 ...S ^TMP("OCXCMP",$J,"DATA FIELD",OCXDF)=1
88 .;
89 .I OCXELM D Q
90 ..S OCXFLD=OCXFSPEC,OCXDF=0
91 ..S OCXCON=$$DATACON(+OCXELM) Q:'$L(OCXCON)
92 ..S OCXDF=$$DATAFLD(OCXFLD,OCXCON)
93 ..I (OCXDF=-1) D WARN^OCXOCMPV(" "_OCXFLD_" data field name not unique.",2,OCXD0,$P($T(+1)," ",1)) Q
94 ..I (OCXDF=-2) D WARN^OCXOCMPV(" "_OCXFLD_" data field not in Data Field file.",2,OCXD0,$P($T(+1)," ",1)) Q
95 ..I 'OCXDF S OCXDF=$$DATAFLD(OCXFLD,OCXDLK)
96 ..I 'OCXDF D WARN^OCXOCMPV(" "_OCXFLD_" data field not defined for "_OCXCON_" data context.",2,OCXD0,$P($T(+1)," ",1)) Q
97 ..I '$G(OCXAUTO) W:($X>60) ! W "."
98 ..S ^TMP("OCXCMP",$J,"ELEMENT",OCXELM,"DATA",OCXDF)=OCXREF
99 ..I '$D(^TMP("OCXCMP",$J,"DATA FIELD",OCXDF)) D
100 ...I '$G(OCXAUTO) W:($X>60) ! W "."
101 ...S ^TMP("OCXCMP",$J,"DATA FIELD",OCXDF)=1
102 .;
103 .S OCXFLD=OCXFSPEC,OCXDF=0
104 .S OCXD1=0 F S OCXD1=$O(^OCXS(860.2,OCXD0,"C",OCXD1)) Q:'OCXD1 D
105 ..S OCXELE=+$P($G(^OCXS(860.2,OCXD0,"C",OCXD1,0)),U,2) Q:'OCXELE
106 ..S OCXCON=$$DATACON(+OCXELE) Q:'$L(OCXCON)
107 ..S OCXDF=$$DATAFLD(OCXFLD,OCXCON)
108 ..I (OCXDF=-1) D WARN^OCXOCMPV(" "_OCXFLD_" data field name not unique.",2,OCXD0,$P($T(+1)," ",1)) Q
109 ..I (OCXDF=-2) D WARN^OCXOCMPV(" "_OCXFLD_" data field not in Data Field file.",2,OCXD0,$P($T(+1)," ",1)) Q
110 ..S:'OCXDF OCXDF=$$DATAFLD(OCXFLD,OCXDLK)
111 ..Q:'OCXDF
112 ..;
113 ..I '$G(OCXAUTO) W:($X>60) ! W "."
114 ..S ^TMP("OCXCMP",$J,"ELEMENT",OCXELE,"DATA",OCXDF)=OCXREF
115 ..I '$D(^TMP("OCXCMP",$J,"DATA FIELD",OCXDF)) D
116 ...I '$G(OCXAUTO) W:($X>60) ! W "."
117 ...S ^TMP("OCXCMP",$J,"DATA FIELD",OCXDF)=1
118 Q
119 ;
120DATACON(OCXEL) ;
121 ;
122 Q +$P($G(^OCXS(860.3,OCXEL,0)),U,2)
123 ;
124LABEL(OCXD0,OCXLABL) ;
125 ;
126 N OCXEL
127 Q:'$L(OCXLABL) 0 S OCXEL=+$O(^OCXS(860.2,OCXD0,"C","B",OCXLABL,0)) Q:'OCXEL 0
128 Q (+OCXEL)_U_+$P($G(^OCXS(860.2,OCXD0,"C",OCXEL,0)),U,2)
129 ;
130DATAFLD(FNAM,CONTXT) ;
131 ;
132 N FNUM,D0
133 Q:'$G(CONTXT) 0
134 S FNUM=$O(^OCXS(860.4,"C",FNAM,0))
135 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)
136 I 'FNUM Q -2
137 ;
138 Q:$O(^OCXS(860.4,"B",FNAM,FNUM)) -1
139 Q:$L($G(^OCXS(860.4,FNUM,"LINK",CONTXT,"DATAPATH"))) FNUM
140 Q 0
141 ;
Note: See TracBrowser for help on using the repository browser.