1 | OCXSENDB ;SLC/RJS,CLA - BUILD RULE TRANSPORTER ROUTINES (Get List of Objects to Transport continued) ;8/04/98 13:21
|
---|
2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,105,143**;Dec 17,1997
|
---|
3 | ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
|
---|
4 | ;
|
---|
5 | ;
|
---|
6 | DIC(OCXDIC,OCXDIC0,OCXDICA,OCXX,OCXDICS,OCXW) ;
|
---|
7 | ;
|
---|
8 | N DIC,X,Y
|
---|
9 | S DIC=$G(OCXDIC) Q:'$L(DIC) -1
|
---|
10 | S DIC(0)=$G(OCXDIC0) S:$L($G(OCXX)) X=OCXX
|
---|
11 | S:$L($G(OCXDICS)) DIC("S")=OCXDICS
|
---|
12 | S:$L($G(OCXDICA)) DIC("A")=OCXDICA
|
---|
13 | S:$L($G(OCXW)) DIC("W")=OCXW
|
---|
14 | D ^DIC Q:(Y<1) 0 Q Y
|
---|
15 | ;
|
---|
16 | CHECK(FILE,VALUE) ;
|
---|
17 | ;
|
---|
18 | N IEN,OCXID
|
---|
19 | Q:'$L(VALUE)
|
---|
20 | I (VALUE[U),VALUE S VALUE=+VALUE
|
---|
21 | I (VALUE=+VALUE) S IEN=VALUE
|
---|
22 | E S IEN=+$$DIC(FILE,"XM","",VALUE)
|
---|
23 | I 'IEN W !!,$P(^OCXS(FILE,0),U,1)," -1-> ",VALUE," [",IEN,"] ERROR - RECORD NOT FOUND" Q
|
---|
24 | I '$D(^OCXS(FILE,IEN)) W !!,$P(^OCXS(FILE,0),U,1)," -2-> ",VALUE," [",IEN,"] ERROR - RECORD NOT FOUND" Q
|
---|
25 | D ADDREC^OCXSEND1(FILE,IEN)
|
---|
26 | Q
|
---|
27 | ;
|
---|
28 | 8602 ; ORDER CHECK RULE
|
---|
29 | ;
|
---|
30 | N D0,MSG,PIEC
|
---|
31 | ;
|
---|
32 | S D0=0 F S D0=$O(^OCXS(FILE,REC,"C",D0)) Q:'D0 D ; TRUTH ELEMENTS multiple
|
---|
33 | .D CHECK(860.3,$P($G(^OCXS(FILE,REC,"C",D0,0)),U,2)) ; ELEMENT NAME
|
---|
34 | ;
|
---|
35 | S D0=0 F S D0=$O(^OCXS(FILE,REC,"R",D0)) Q:'D0 D ; RELATION ACTIONS multiple
|
---|
36 | .S MSG=$G(^OCXS(FILE,REC,"R",D0,"MSG"))
|
---|
37 | .I (MSG["|") F PIEC=2:2:$L(MSG,"|") D CHECK(860.4,$P(MSG,"|",PIEC))
|
---|
38 | .S MSG=$G(^OCXS(FILE,REC,"R",D0,"OCMSG"))
|
---|
39 | .I (MSG["|") F PIEC=2:2:$L(MSG,"|") D CHECK(860.4,$P(MSG,"|",PIEC))
|
---|
40 | ;
|
---|
41 | Q
|
---|
42 | ;
|
---|
43 | 8603 ; ORDER CHECK ELEMENT
|
---|
44 | ;
|
---|
45 | N D0,OPER,TERM
|
---|
46 | ;
|
---|
47 | D CHECK(860.6,$P($G(^OCXS(FILE,REC,0)),U,2)) ; ELEMENT CONTEXT
|
---|
48 | S D0=0 F S D0=$O(^OCXS(FILE,REC,"COND",D0)) Q:'D0 D ; CONDITIONAL EXPRESSION multiple
|
---|
49 | .D CHECK(860.4,$P($G(^OCXS(FILE,REC,"COND",D0,"DFLD1")),U,1)) ; DATA FIELD 1
|
---|
50 | .D CHECK(863.9,$G(^OCXS(FILE,REC,"COND",D0,"OPER"))) ; OPERATOR/FUNCTION
|
---|
51 | .D CHECK(860.4,$G(^OCXS(FILE,REC,"COND",D0,"DFLD2"))) ; DATA FIELD 2
|
---|
52 | .D CHECK(860.4,$P($G(^OCXS(FILE,REC,"COND",D0,"DFLD3")),U,1)) ; DATA FIELD 3
|
---|
53 | .;
|
---|
54 | .S OPER=$G(^OCXS(FILE,REC,"COND",D0,"OPER")) Q:'OPER
|
---|
55 | .S OPER=$P($G(^OCXS(863.9,+OPER,0)),U,1) Q:'(OPER["TERM")
|
---|
56 | .S TERM=$G(^OCXS(FILE,REC,"COND",D0,"VAL1"))
|
---|
57 | .D CHECK(860.9,TERM)
|
---|
58 | ;
|
---|
59 | Q
|
---|
60 | ;
|
---|
61 | 8604 ; ORDER CHECK DATA FIELD
|
---|
62 | ;
|
---|
63 | N D0
|
---|
64 | ;
|
---|
65 | D CHECK(864.1,$P($G(^OCXS(FILE,REC,0)),U,3)) ; DATATYPE
|
---|
66 | S D0=0 F S D0=$O(^OCXS(FILE,REC,"LINK",D0)) Q:'D0 D ; DATA SOURCES multiple
|
---|
67 | .D CHECK(860.6,$P($G(^OCXS(FILE,REC,"LINK",D0,0)),U,1)) ; DATA CONTEXT
|
---|
68 | .D CHECK(860.5,$P($G(^OCXS(FILE,REC,"LINK",D0,0)),U,2)) ; DATA SOURCE
|
---|
69 | .D CHECK(863.3,$G(^OCXS(FILE,REC,"LINK",D0,"DATAPATH"))) ; LINK
|
---|
70 | ;
|
---|
71 | Q
|
---|
72 | ;
|
---|
73 | 8605 ; ORDER CHECK DATA SOURCE
|
---|
74 | ;
|
---|
75 | N D0
|
---|
76 | ;
|
---|
77 | D CHECK(860.6,$P($G(^OCXS(FILE,REC,0)),U,2)) ; CONTEXT
|
---|
78 | Q
|
---|
79 | ;
|
---|
80 | 8608 ; ORDER CHECK COMPILER FUNCTIONS
|
---|
81 | ;
|
---|
82 | N D0,TEXT,PIEC,CALL
|
---|
83 | ;
|
---|
84 | S D0=0 F S D0=$O(^OCXS(FILE,REC,"CODE",D0)) Q:'D0 D ; CODE multiple
|
---|
85 | .S TEXT=$G(^OCXS(FILE,REC,"CODE",D0,0))
|
---|
86 | .;
|
---|
87 | .I (TEXT["$$") F PIEC=2:1:$L(TEXT,"$$") D
|
---|
88 | ..S CALL=$P($P(TEXT,"$$",PIEC),"(",1) Q:'$L(CALL) Q:(CALL[U)
|
---|
89 | ..D CHECK(860.8,CALL)
|
---|
90 | ;
|
---|
91 | Q
|
---|
92 | ;
|
---|
93 | 863 ; OCX MDD CLASS
|
---|
94 | ;
|
---|
95 | N D0
|
---|
96 | ;
|
---|
97 | D CHECK(863,$P($G(^OCXS(FILE,REC,0)),U,3)) ; PARENT CLASS
|
---|
98 | S D0=0 F S D0=$O(^OCXS(FILE,REC,"PAR",D0)) Q:'D0 D ; PARAMETER multiple
|
---|
99 | .D CHECK(863.8,$P($G(^OCXS(FILE,REC,"PAR",D0,0)),U,1)) ; PARAMETER
|
---|
100 | ;
|
---|
101 | Q
|
---|
102 | ;
|
---|
103 | 8631 ; OCX MDD APPLICATION
|
---|
104 | ;
|
---|
105 | N D0
|
---|
106 | ;
|
---|
107 | S D0=0 F S D0=$O(^OCXS(FILE,REC,"PAR",D0)) Q:'D0 D ; PARAMETER multiple
|
---|
108 | .D CHECK(863.8,$P($G(^OCXS(FILE,REC,"PAR",D0,0)),U,1)) ; PARAMETER NAME
|
---|
109 | ;
|
---|
110 | S D0=0 F S D0=$O(^OCXS(FILE,REC,"SUBJ",D0)) Q:'D0 D ; PRIMARY SUBJECT multiple
|
---|
111 | .D CHECK(863.2,$P($G(^OCXS(FILE,REC,"SUBJ",D0,0)),U,1)) ; PRIMARY SUBJECT
|
---|
112 | ;
|
---|
113 | Q
|
---|
114 | ;
|
---|
115 | 8632 ; OCX MDD SUBJECT
|
---|
116 | ;
|
---|
117 | N D0
|
---|
118 | ;
|
---|
119 | S D0=0 F S D0=$O(^OCXS(FILE,REC,"PAR",D0)) Q:'D0 D ; PARAMETER multiple
|
---|
120 | .D CHECK(863.8,$P($G(^OCXS(FILE,REC,"PAR",D0,0)),U,1)) ; PARAMETER NAME
|
---|
121 | ;
|
---|
122 | Q
|
---|
123 | ;
|
---|
124 | 8633 ; OCX MDD LINK
|
---|
125 | ;
|
---|
126 | N D0
|
---|
127 | ;
|
---|
128 | D CHECK(863.2,$P($G(^OCXS(FILE,REC,0)),U,2)) ; PARENT SUBJECT
|
---|
129 | D CHECK(863.2,$P($G(^OCXS(FILE,REC,0)),U,3)) ; DESCENDANT SUBJECT
|
---|
130 | D CHECK(863.4,$P($G(^OCXS(FILE,REC,0)),U,5)) ; ATTRIBUTE
|
---|
131 | ;
|
---|
132 | S FCPARM=$O(^OCXS(863.8,"B","OCXO EXTERNAL FUNCTION CALL",0))
|
---|
133 | ;
|
---|
134 | S D0=0 F S D0=$O(^OCXS(FILE,REC,"PAR",D0)) Q:'D0 D ; PARAMETER multiple
|
---|
135 | .N PARM,PIEC
|
---|
136 | .S PARM=$P($G(^OCXS(FILE,REC,"PAR",D0,0)),U,1) ; PARAMETER NAME
|
---|
137 | .D CHECK(863.8,PARM) ; PARAMETER NAME
|
---|
138 | .S PARMV=$G(^OCXS(FILE,REC,"PAR",D0,"VAL")) ; PARAMETER NAME
|
---|
139 | .Q:'(PARM=FCPARM)
|
---|
140 | .I '($P(PARMV,"(")[U) D CHECK(860.8,$P(PARMV,"(",1))
|
---|
141 | .I (PARMV["|") F PIEC=2:2:$L(PARMV,"|") D CHECK(860.4,$P(PARMV,"|",PIEC))
|
---|
142 | ;
|
---|
143 | Q
|
---|
144 | ;
|
---|
145 | 8634 ; OCX MDD ATTRIBUTE
|
---|
146 | ;
|
---|
147 | N D0
|
---|
148 | ;
|
---|
149 | D CHECK(863.4,$P($G(^OCXS(FILE,REC,"MOM")),U,1)) ; PARENT ATTRIBUTE
|
---|
150 | S D0=0 F S D0=$O(^OCXS(FILE,REC,"PAR",D0)) Q:'D0 D ; PARAMETER multiple
|
---|
151 | .D CHECK(863.8,$P($G(^OCXS(FILE,REC,"PAR",D0,0)),U,1)) ; PARAMETER NAME
|
---|
152 | ;
|
---|
153 | Q
|
---|
154 | ;
|
---|
155 | 8635 ; OCX MDD VALUES
|
---|
156 | ;
|
---|
157 | N D0
|
---|
158 | ;
|
---|
159 | S D0=0 F S D0=$O(^OCXS(FILE,REC,"PAR",D0)) Q:'D0 D ; PARAMETER multiple
|
---|
160 | .D CHECK(863.8,$P($G(^OCXS(FILE,REC,"PAR",D0,0)),U,1)) ; PARAMETER
|
---|
161 | ;
|
---|
162 | Q
|
---|
163 | ;
|
---|
164 | 8636 ; OCX MDD METHOD
|
---|
165 | ;
|
---|
166 | N D0
|
---|
167 | ;
|
---|
168 | D CHECK(863,$P($G(^OCXS(FILE,REC,0)),U,3)) ; CLASS FILE
|
---|
169 | ;
|
---|
170 | S D0=0 F S D0=$O(^OCXS(FILE,REC,"PAR",D0)) Q:'D0 D ; PARAMETER multiple
|
---|
171 | .D CHECK(863.8,$P($G(^OCXS(FILE,REC,"PAR",D0,0)),U,1)) ; PARAMETER NAME
|
---|
172 | ;
|
---|
173 | Q
|
---|
174 | ;
|
---|
175 | 8637 ; OCX MDD PUBLIC FUNCTION
|
---|
176 | ;
|
---|
177 | N D0
|
---|
178 | ;
|
---|
179 | S D0=0 F S D0=$O(^OCXS(FILE,REC,"PAR",D0)) Q:'D0 D ; PARAMETER multiple
|
---|
180 | .D CHECK(863.8,$P($G(^OCXS(FILE,REC,"PAR",D0,0)),U,1)) ; PARAMETERS
|
---|
181 | ;
|
---|
182 | Q
|
---|
183 | ;
|
---|
184 | 8638 ; OCX MDD PARAMETER
|
---|
185 | ;
|
---|
186 | N D0
|
---|
187 | ;
|
---|
188 | S D0=0 F S D0=$O(^OCXS(FILE,REC,"PAR",D0)) Q:'D0 D ; PARAMETER ATTRIBUTE multiple
|
---|
189 | .D CHECK(863.8,$P($G(^OCXS(FILE,REC,"PAR",D0,0)),U,1)) ; PARAMETER
|
---|
190 | ;
|
---|
191 | Q
|
---|
192 | ;
|
---|
193 | 8639 ; OCX MDD CONDITION/FUNCTION
|
---|
194 | ;
|
---|
195 | N D0
|
---|
196 | ;
|
---|
197 | D CHECK(864.1,$P($G(^OCXS(FILE,REC,0)),U,2)) ; DATATYPE
|
---|
198 | D CHECK(863.7,$P($G(^OCXS(FILE,REC,0)),U,3)) ; CODE GENERATOR FUNCTION
|
---|
199 | S D0=0 F S D0=$O(^OCXS(FILE,REC,"PAR",D0)) Q:'D0 D ; PARAMETER multiple
|
---|
200 | .S PARM=$P($G(^OCXS(FILE,REC,"PAR",D0,0)),U,1)
|
---|
201 | .S PARMV=$G(^OCXS(FILE,REC,"PAR",D0,"VAL"))
|
---|
202 | .D CHECK(863.8,PARM) ; PARAMETER
|
---|
203 | .I (PARM="OCXO GENERATE CODE FUNCTION") D CHECK(863.7,PARMV)
|
---|
204 | ;
|
---|
205 | Q
|
---|
206 | ;
|
---|
207 | 8641 ; OCX MDD DATATYPE
|
---|
208 | ;
|
---|
209 | N D0
|
---|
210 | ;
|
---|
211 | D CHECK(864.1,$P($G(^OCXS(FILE,REC,"MOM")),U,1)) ; PARENT DATA TYPE
|
---|
212 | S D0=0 F S D0=$O(^OCXS(FILE,REC,"PAR",D0)) Q:'D0 D ; PARAMETER multiple
|
---|
213 | .D CHECK(863.8,$P($G(^OCXS(FILE,REC,"PAR",D0,0)),U,1)) ; PARAMETER NAME
|
---|
214 | ;
|
---|
215 | Q
|
---|