source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORY23405.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 7.3 KB
Line 
1ORY23405 ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Install of OR*3*234) ;MAY 13,2005 at 09:31
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**234**;Dec 17,1997
3 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
4 ;
5S ;
6 ;
7 D DOT^ORY234ES
8 ;
9 ;
10 K REMOTE,LOCAL,OPCODE,REF
11 F LINE=1:1:500 S TEXT=$P($T(DATA+LINE),";",2,999) Q:TEXT I $L(TEXT) D Q:QUIT
12 .S ^TMP("OCXRULE",$J,$O(^TMP("OCXRULE",$J,"A"),-1)+1)=TEXT
13 ;
14 G ^ORY23406
15 ;
16 Q
17 ;
18DATA ;
19 ;
20 ;;R^"860.8:",100,23
21 ;;D^ ; Q OCXMON_" "_OCXDAY_","_OCXYR
22 ;;R^"860.8:",100,24
23 ;;D^ ; ;
24 ;;EOR^
25 ;;KEY^860.8:^ELAPSED ORDER CHECK TIME LOGGER
26 ;;R^"860.8:",.01,"E"
27 ;;D^ELAPSED ORDER CHECK TIME LOGGER
28 ;;R^"860.8:",.02,"E"
29 ;;D^TIMELOG
30 ;;R^"860.8:",100,1
31 ;;D^ ;TIMELOG(OCXMODE,OCXCALL) ; Log an entry in the Elapsed time log.
32 ;;R^"860.8:",100,2
33 ;;D^ ; ;
34 ;;R^"860.8:",100,3
35 ;;D^ ; ;
36 ;;R^"860.8:",100,4
37 ;;D^ ; Q 0
38 ;;R^"860.8:",100,5
39 ;;D^ ; ;
40 ;;EOR^
41 ;;KEY^860.8:^EQUALS TERM OPERATOR
42 ;;R^"860.8:",.01,"E"
43 ;;D^EQUALS TERM OPERATOR
44 ;;R^"860.8:",.02,"E"
45 ;;D^EQTERM
46 ;;R^"860.8:",100,1
47 ;;D^ ;EQTERM(DATA,TERM) ;
48 ;;R^"860.8:",100,2
49 ;;D^ ; ;
50 ;;R^"860.8:",100,3
51 ;;D^T+; I $G(OCXTRACE) W !,"%%%%",?20," Execution trace DATA: ",$G(DATA)," TERM: ",$G(TERM)
52 ;;R^"860.8:",100,4
53 ;;D^ ; N OCXF,OCXL
54 ;;R^"860.8:",100,5
55 ;;D^ ; ;
56 ;;R^"860.8:",100,6
57 ;;D^ ; S OCXL="",OCXF=$$TERMLKUP(TERM,.OCXL)
58 ;;R^"860.8:",100,7
59 ;;D^T-; Q:'OCXF 0
60 ;;R^"860.8:",100,8
61 ;;D^T+; I 'OCXF W:$G(OCXTRACE) !,"%%%%",?20," Term '",TERM,"' not in Order Check National Term File" Q 0
62 ;;R^"860.8:",100,9
63 ;;D^T+; I '$O(OCXL(0)) W:$G(OCXTRACE) !,"%%%%",?20," There are no local terms listed for the National Term '",TERM,"'." Q 0
64 ;;R^"860.8:",100,10
65 ;;D^T+; I ($D(OCXL(DATA))!$D(OCXL("B",DATA))) W:$G(OCXTRACE) !,"%%%%",?20," Data equals Term" Q 1
66 ;;R^"860.8:",100,11
67 ;;D^T-; I ($D(OCXL(DATA))!$D(OCXL("B",DATA))) Q 1
68 ;;R^"860.8:",100,12
69 ;;D^T-; Q 0
70 ;;R^"860.8:",100,13
71 ;;D^T+; W:$G(OCXTRACE) !,"%%%%",?20," Data does not equal Term" Q 0
72 ;;R^"860.8:",100,14
73 ;;D^ ; ;
74 ;;EOR^
75 ;;KEY^860.8:^FILE DATA IN PATIENT ACTIVE DATA FILE
76 ;;R^"860.8:",.01,"E"
77 ;;D^FILE DATA IN PATIENT ACTIVE DATA FILE
78 ;;R^"860.8:",.02,"E"
79 ;;D^FILE
80 ;;R^"860.8:",1,1
81 ;;D^ ;FILE(DFN,OCXELE,OCXDFL) ; This Local Extrinsic Function files data
82 ;;R^"860.8:",1,2
83 ;;D^ ; ; in the Order Check Patient Data File
84 ;;R^"860.8:",1,3
85 ;;D^ ; ;
86 ;;R^"860.8:",100,1
87 ;;D^ ;FILE(DFN,OCXELE,OCXDFL) ; This Local Extrinsic Function logs a validated event/element.
88 ;;R^"860.8:",100,2
89 ;;D^ ; ;
90 ;;R^"860.8:",100,3
91 ;;D^T+; I $G(OCXTRACE) W !,"%%%%",?20," Execution trace DFN: ",DFN," OCXELE: ",+$G(OCXELE)," OCXDFL: ",$G(OCXDFL)
92 ;;R^"860.8:",100,4
93 ;;D^ ; N OCXTIMN,OCXTIML,OCXTIMT1,OCXTIMT2,OCXDATA,OCXPC,OCXPC,OCXVAL,OCXSUB,OCXDFI
94 ;;R^"860.8:",100,5
95 ;;D^ ; S DFN=+$G(DFN),OCXELE=+$G(OCXELE)
96 ;;R^"860.8:",100,6
97 ;;D^ ; ;
98 ;;R^"860.8:",100,7
99 ;;D^ ; Q:'DFN 1 Q:'OCXELE 1 K OCXDATA
100 ;;R^"860.8:",100,8
101 ;;D^ ; ;
102 ;;R^"860.8:",100,9
103 ;;D^ ; S OCXDATA(DFN,OCXELE)=1
104 ;;R^"860.8:",100,10
105 ;;D^ ; F OCXPC=1:1:$L(OCXDFL,",") S OCXDFI=$P(OCXDFL,",",OCXPC) I OCXDFI D
106 ;;R^"860.8:",100,11
107 ;;D^ ; .S OCXVAL=$G(OCXDF(+OCXDFI)),OCXDATA(DFN,OCXELE,+OCXDFI)=OCXVAL
108 ;;R^"860.8:",100,12
109 ;;D^T+; .I $G(OCXTRACE) W !,"%%%%",?20," ",$P($G(^OCXS(860.4,+OCXDFI,0)),U,1)," = """,OCXVAL,""""
110 ;;R^"860.8:",100,13
111 ;;D^ ; ;
112 ;;R^"860.8:",100,14
113 ;;D^ ; M ^TMP("OCXCHK",$J,DFN)=OCXDATA(DFN)
114 ;;R^"860.8:",100,15
115 ;;D^ ; ;
116 ;;R^"860.8:",100,16
117 ;;D^ ; Q 0
118 ;;R^"860.8:",100,17
119 ;;D^ ; ;
120 ;;EOR^
121 ;;KEY^860.8:^GENERATE STRING CHECKSUM
122 ;;R^"860.8:",.01,"E"
123 ;;D^GENERATE STRING CHECKSUM
124 ;;R^"860.8:",.02,"E"
125 ;;D^CKSUM
126 ;;R^"860.8:",100,1
127 ;;D^ ;CKSUM(STR) ;
128 ;;R^"860.8:",100,2
129 ;;D^ ; ;
130 ;;R^"860.8:",100,3
131 ;;D^ ; N CKSUM,PTR,ASC S CKSUM=0
132 ;;R^"860.8:",100,4
133 ;;D^ ; S STR=$TR(STR,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
134 ;;R^"860.8:",100,5
135 ;;D^ ; F PTR=$L(STR):-1:1 S ASC=$A(STR,PTR)-42 I (ASC>0),(ASC<51) S CKSUM=CKSUM*2+ASC
136 ;;R^"860.8:",100,6
137 ;;D^ ; Q +CKSUM
138 ;;R^"860.8:",100,7
139 ;;D^ ; ;
140 ;;EOR^
141 ;;KEY^860.8:^GET DATA FROM THE ACTIVE DATA FILE
142 ;;R^"860.8:",.01,"E"
143 ;;D^GET DATA FROM THE ACTIVE DATA FILE
144 ;;R^"860.8:",.02,"E"
145 ;;D^GETDATA
146 ;;R^"860.8:",100,1
147 ;;D^ ;GETDATA(DFN,OCXL,OCXDFI) ; This Local Extrinsic Function returns runtime data
148 ;;R^"860.8:",100,2
149 ;;D^ ; ;
150 ;;R^"860.8:",100,3
151 ;;D^ ; N OCXE,VAL,PC S VAL=""
152 ;;R^"860.8:",100,4
153 ;;D^ ; F PC=1:1:$L(OCXL,U) S OCXE=$P(OCXL,U,PC) I OCXE S VAL=$G(^TMP("OCXCHK",$J,DFN,OCXE,OCXDFI)) Q:$L(VAL)
154 ;;R^"860.8:",100,5
155 ;;D^ ; Q VAL
156 ;;R^"860.8:",100,6
157 ;;D^ ; ;
158 ;;EOR^
159 ;;KEY^860.8:^IN LIST OPERATOR
160 ;;R^"860.8:",.01,"E"
161 ;;D^IN LIST OPERATOR
162 ;;R^"860.8:",.02,"E"
163 ;;D^LIST
164 ;;R^"860.8:",100,1
165 ;;D^ ;LIST(DATA,LIST) ; IS THE DATA FIELD IN THE LIST
166 ;;R^"860.8:",100,2
167 ;;D^ ; ;
168 ;;R^"860.8:",100,3
169 ;;D^T+; W:$G(OCXTRACE) !,"%%%%",?20," $$LIST(""",DATA,""",""",LIST,""")"
170 ;;R^"860.8:",100,4
171 ;;D^ ; S:'($E(LIST,1)=",") LIST=","_LIST S:'($E(LIST,$L(LIST))=",") LIST=LIST_"," S DATA=","_DATA_","
172 ;;R^"860.8:",100,5
173 ;;D^ ; Q (LIST[DATA)
174 ;;R^"860.8:",100,6
175 ;;D^ ; ;
176 ;;EOR^
177 ;;KEY^860.8:^LOCAL TERM LOOKUP
178 ;;R^"860.8:",.01,"E"
179 ;;D^LOCAL TERM LOOKUP
180 ;;R^"860.8:",.02,"E"
181 ;;D^TERMLKUP
182 ;;R^"860.8:",1,1
183 ;;D^
184 ;;R^"860.8:",1,2
185 ;;D^ This function allows a local site to define to Order Checking
186 ;;R^"860.8:",1,3
187 ;;D^ a term specific to that site. (ie. Lab Test Name, Radiology
188 ;;R^"860.8:",1,4
189 ;;D^ procedure name, etc.)
190 ;;R^"860.8:",1,5
191 ;;D^
192 ;;R^"860.8:",100,1
193 ;;D^ ;TERMLKUP(OCXTERM,OCXFILE) ;
194 ;;R^"860.8:",100,2
195 ;;D^ ; ;
196 ;;R^"860.8:",100,3
197 ;;D^ ; Q
198 ;;R^"860.8:",100,4
199 ;;D^ ; ;
200 ;;EOR^
201 ;;KEY^860.8:^NEW RULE MESSAGE
202 ;;R^"860.8:",.01,"E"
203 ;;D^NEW RULE MESSAGE
204 ;;R^"860.8:",.02,"E"
205 ;;D^NEWRULE
206 ;;R^"860.8:",100,1
207 ;;D^ ;NEWRULE(OCXDFN,OCXORD,OCXRUL,OCXREL,OCXNOTF,OCXMESS) ; Has this rule already been triggered for this order number
208 ;;R^"860.8:",100,2
209 ;;D^ ; ;
210 ;;R^"860.8:",100,3
211 ;;D^L+; S OCXERR=$$TIMELOG("M","NEWRULE("_(+$G(OCXDFN))_","_(+$G(OCXORD))_","_(+$G(OCXRUL))_","_(+$G(OCXREL))_","_(+$G(OCXNOTF))_","_$G(OCXMESS)_")")
212 ;;R^"860.8:",100,4
213 ;;D^ ; ;
214 ;;R^"860.8:",100,5
215 ;;D^ ; Q:'$G(OCXDFN) 0 Q:'$G(OCXRUL) 0
216 ;;R^"860.8:",100,6
217 ;;D^ ; Q:'$G(OCXREL) 0 Q:'$G(OCXNOTF) 0 Q:'$L($G(OCXMESS)) 0
218 ;;R^"860.8:",100,7
219 ;;D^ ; S OCXORD=+$G(OCXORD),OCXDFN=+OCXDFN
220 ;;R^"860.8:",100,8
221 ;;D^ ; ;
222 ;;R^"860.8:",100,9
223 ;;D^ ; N OCXNDX,OCXDATA,OCXDFI,OCXELE,OCXGR,OCXTIME,OCXCKSUM,OCXTSP,OCXTSPL
224 ;;R^"860.8:",100,10
225 ;;D^ ; ;
226 ;;R^"860.8:",100,11
227 ;;D^ ; S OCXTIME=(+$H)
228 ;;R^"860.8:",100,12
229 ;;D^ ; S OCXCKSUM=$$CKSUM(OCXMESS)
230 ;;R^"860.8:",100,13
231 ;;D^ ; ;
232 ;;R^"860.8:",100,14
233 ;;D^ ; S OCXTSP=($H*86400)+$P($H,",",2)
234 ;;R^"860.8:",100,15
235 ;;D^ ; S OCXTSPL=($G(^OCXD(860.7,"AT",OCXTIME,OCXDFN,OCXRUL,+OCXORD,OCXCKSUM))+$G(OCXTSPI,300))
236 ;;R^"860.8:",100,16
237 ;;D^ ; ;
238 ;;R^"860.8:",100,17
239 ;;D^ ; Q:(OCXTSPL>OCXTSP) 0
240 ;;R^"860.8:",100,18
241 ;;D^ ; ;
242 ;;R^"860.8:",100,19
243 ;;D^ ; K OCXDATA
244 ;;R^"860.8:",100,20
245 ;;D^ ; S OCXDATA(OCXDFN,0)=OCXDFN
246 ;;R^"860.8:",100,21
247 ;;D^ ; S OCXDATA("B",OCXDFN,OCXDFN)=""
248 ;;R^"860.8:",100,22
249 ;;D^ ; S OCXDATA("AT",OCXTIME,OCXDFN,OCXRUL,+OCXORD,OCXCKSUM)=OCXTSP
250 ;;R^"860.8:",100,23
251 ;;D^ ; ;
252 ;;R^"860.8:",100,24
253 ;;D^ ; S OCXGR="^OCXD(860.7"
254 ;;R^"860.8:",100,25
255 ;;D^T+; D SETAP(OCXGR_")",0,"Patient",$P($G(^DPT(OCXDFN,0)),U,1),.OCXDATA,OCXDFN)
256 ;1;
257 ;
Note: See TracBrowser for help on using the repository browser.