source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORY21104.m@ 1211

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

initial load of WorldVistAEHR

File size: 7.2 KB
RevLine 
[613]1ORY21104 ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Install of OR*3*211) ;APR 5,2005 at 08:07
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**211**;Dec 17,1997
3 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
4 ;
5S ;
6 ;
7 D DOT^ORY211ES
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 ^ORY21105
15 ;
16 Q
17 ;
18DATA ;
19 ;
20 ;;D^ABREN(|PATIENT IEN|)
21 ;;R^"863.3:","863.32:2",.01,"E"
22 ;;D^OCXO UP-ARROW PIECE NUMBER
23 ;;R^"863.3:","863.32:2",1,"E"
24 ;;D^2
25 ;;EOR^
26 ;;KEY^863.3:^PATIENT.TAKING_GLUCOPHAGE
27 ;;R^"863.3:",.01,"E"
28 ;;D^PATIENT.TAKING_GLUCOPHAGE
29 ;;R^"863.3:",.02,"E"
30 ;;D^PATIENT
31 ;;R^"863.3:",.05,"E"
32 ;;D^CURRENT GLUCOPHAGE FLAG
33 ;;R^"863.3:",.06,"E"
34 ;;D^999
35 ;;R^"863.3:","863.32:1",.01,"E"
36 ;;D^OCXO EXTERNAL FUNCTION CALL
37 ;;R^"863.3:","863.32:1",1,"E"
38 ;;D^TAKEMED^ORKPS(|PATIENT IEN|,"^GLUCOPHAGE^METFORMIN^AVANDAMET^METAGLIP")
39 ;;R^"863.3:","863.32:2",.01,"E"
40 ;;D^OCXO UP-ARROW PIECE NUMBER
41 ;;R^"863.3:","863.32:2",1,"E"
42 ;;D^1
43 ;;EOR^
44 ;;EOF^OCXS(863.3)^1
45 ;;SOF^860.9 ORDER CHECK NATIONAL TERM
46 ;;KEY^860.9:^ANGIOGRAM (PERIPHERAL)
47 ;;R^"860.9:",.01,"E"
48 ;;D^ANGIOGRAM (PERIPHERAL)
49 ;;R^"860.9:",.02,"E"
50 ;;D^101.43
51 ;;EOR^
52 ;;KEY^860.9:^BLOOD SPECIMEN
53 ;;R^"860.9:",.01,"E"
54 ;;D^BLOOD SPECIMEN
55 ;;R^"860.9:",.02,"E"
56 ;;D^61
57 ;;EOR^
58 ;;KEY^860.9:^DANGEROUS MEDS FOR PTS > 64
59 ;;R^"860.9:",.01,"E"
60 ;;D^DANGEROUS MEDS FOR PTS > 64
61 ;;R^"860.9:",.02,"E"
62 ;;D^101.43
63 ;;R^"860.9:",2,"E"
64 ;;D^I $P($G(^ORD(100.98,$P($G(^ORD(101.43,+Y,0)),U,5),0)),U)="PHARMACY"
65 ;;EOR^
66 ;;KEY^860.9:^DNR
67 ;;R^"860.9:",.01,"E"
68 ;;D^DNR
69 ;;R^"860.9:",.02,"E"
70 ;;D^101.43
71 ;;EOR^
72 ;;KEY^860.9:^EGFR
73 ;;R^"860.9:",.01,"E"
74 ;;D^EGFR
75 ;;R^"860.9:",.02,"E"
76 ;;D^60
77 ;;EOR^
78 ;;KEY^860.9:^FOOD-DRUG INTERACTION MED
79 ;;R^"860.9:",.01,"E"
80 ;;D^FOOD-DRUG INTERACTION MED
81 ;;R^"860.9:",.02,"E"
82 ;;D^101.43
83 ;;R^"860.9:",2,"E"
84 ;;D^I $P($G(^ORD(100.98,$P($G(^ORD(101.43,+Y,0)),U,5),0)),U)="PHARMACY"
85 ;;EOR^
86 ;;KEY^860.9:^NPO
87 ;;R^"860.9:",.01,"E"
88 ;;D^NPO
89 ;;R^"860.9:",.02,"E"
90 ;;D^101.43
91 ;;EOR^
92 ;;KEY^860.9:^ONE TIME MED
93 ;;R^"860.9:",.01,"E"
94 ;;D^ONE TIME MED
95 ;;R^"860.9:",.02,"E"
96 ;;D^51.1
97 ;;R^"860.9:",2,"E"
98 ;;D^I $E($P(^(0),U,4),1,2)="PS"
99 ;;EOR^
100 ;;KEY^860.9:^PARTIAL THROMBOPLASTIN TIME
101 ;;R^"860.9:",.01,"E"
102 ;;D^PARTIAL THROMBOPLASTIN TIME
103 ;;R^"860.9:",.02,"E"
104 ;;D^101.43
105 ;;EOR^
106 ;;KEY^860.9:^PROTHROMBIN TIME
107 ;;R^"860.9:",.01,"E"
108 ;;D^PROTHROMBIN TIME
109 ;;R^"860.9:",.02,"E"
110 ;;D^101.43
111 ;;EOR^
112 ;;KEY^860.9:^SERUM CREATININE
113 ;;R^"860.9:",.01,"E"
114 ;;D^SERUM CREATININE
115 ;;R^"860.9:",.02,"E"
116 ;;D^60
117 ;;EOR^
118 ;;KEY^860.9:^SERUM SPECIMEN
119 ;;R^"860.9:",.01,"E"
120 ;;D^SERUM SPECIMEN
121 ;;R^"860.9:",.02,"E"
122 ;;D^61
123 ;;EOR^
124 ;;KEY^860.9:^SERUM UREA NITROGEN
125 ;;R^"860.9:",.01,"E"
126 ;;D^SERUM UREA NITROGEN
127 ;;R^"860.9:",.02,"E"
128 ;;D^60
129 ;;EOR^
130 ;;KEY^860.9:^WBC
131 ;;R^"860.9:",.01,"E"
132 ;;D^WBC
133 ;;R^"860.9:",.02,"E"
134 ;;D^60
135 ;;EOR^
136 ;;EOF^OCXS(860.9)^1
137 ;;SOF^860.8 ORDER CHECK COMPILER FUNCTIONS
138 ;;KEY^860.8:^CONVERT DATE FROM FILEMAN FORMAT TO OCX FORMAT
139 ;;R^"860.8:",.01,"E"
140 ;;D^CONVERT DATE FROM FILEMAN FORMAT TO OCX FORMAT
141 ;;R^"860.8:",.02,"E"
142 ;;D^DT2INT
143 ;;R^"860.8:",1,1
144 ;;D^ ;DT2INT(OCXDT) ; This Local Extrinsic Function converts a date into an integer
145 ;;R^"860.8:",1,2
146 ;;D^ ; ; By taking the Years, Months, Days, Hours and Minutes converting
147 ;;R^"860.8:",1,3
148 ;;D^ ; ; Them into Seconds and then adding them all together into one big integer
149 ;;R^"860.8:",100,1
150 ;;D^ ;DT2INT(OCXDT) ; This Local Extrinsic Function converts a date into an integer
151 ;;R^"860.8:",100,2
152 ;;D^ ; ; By taking the Years, Months, Days, Hours and Minutes converting
153 ;;R^"860.8:",100,3
154 ;;D^ ; ; Them into Seconds and then adding them all together into one big integer
155 ;;R^"860.8:",100,4
156 ;;D^ ; ;
157 ;;R^"860.8:",100,5
158 ;;D^ ; Q:'$L($G(OCXDT)) ""
159 ;;R^"860.8:",100,6
160 ;;D^ ; N OCXDIFF,OCXVAL S (OCXDIFF,OCXVAL)=0
161 ;;R^"860.8:",100,7
162 ;;D^ ; ;
163 ;;R^"860.8:",100,8
164 ;;D^ ; I $L(OCXDT),'OCXDT,(OCXDT[" at ") D ; EXTERNAL EXPERT SYSTEM FORMAT 1 TO EXTERNAL FORMAT
165 ;;R^"860.8:",100,9
166 ;;D^ ; .N OCXHR,OCXMIN,OCXTIME
167 ;;R^"860.8:",100,10
168 ;;D^ ; .S OCXTIME=$P($P(OCXDT," at ",2),".",1),OCXHR=$P(OCXTIME,":",1),OCXMIN=$P(OCXTIME,":",2)
169 ;;R^"860.8:",100,11
170 ;;D^ ; .S:(OCXDT["Midnight") OCXHR=00
171 ;;R^"860.8:",100,12
172 ;;D^ ; .S:(OCXDT["PM") OCXHR=OCXHR+12
173 ;;R^"860.8:",100,13
174 ;;D^ ; .S OCXDT=$P(OCXDT," at ")_"@"_$E(OCXHR+100,2,3)_$E(OCXMIN+100,2,3)
175 ;;R^"860.8:",100,14
176 ;;D^ ; ;
177 ;;R^"860.8:",100,15
178 ;;D^ ; I $L(OCXDT),(OCXDT?1.2N1"/"1.2N.1" ".2N.1":".2N) D ; EXTERNAL EXPERT SYSTEM FORMAT 2 TO EXTERNAL FORMAT
179 ;;R^"860.8:",100,16
180 ;;D^ ; .N OCXMON
181 ;;R^"860.8:",100,17
182 ;;D^ ; .S OCXMON=$P("January^February^March^April^May^June^July^August^September^October^November^December",U,$P(OCXDT,"/",1))
183 ;;R^"860.8:",100,18
184 ;;D^ ; .I $L($P(OCXDT," ",2)) S OCXDT=OCXMON_" "_$P($P(OCXDT," ",1),"/",2)_"@"_$TR($P(OCXDT," ",2),":","")
185 ;;R^"860.8:",100,19
186 ;;D^ ; .E S OCXDT=OCXMON_" "_$P($P(OCXDT," ",1),"/",2)
187 ;;R^"860.8:",100,20
188 ;;D^ ; ;
189 ;;R^"860.8:",100,21
190 ;;D^ ; I $L(OCXDT),(OCXDT?1.2N1"/"1.2N1"/"1.2N.1" ".2N.1":".2N) D ; EXTERNAL EXPERT SYSTEM FORMAT 3 TO EXTERNAL FORMAT
191 ;;R^"860.8:",100,22
192 ;;D^ ; .N OCXMON
193 ;;R^"860.8:",100,23
194 ;;D^ ; .S OCXMON=$P("January^February^March^April^May^June^July^August^September^October^November^December",U,$P(OCXDT,"/",1))
195 ;;R^"860.8:",100,24
196 ;;D^ ; .I $L($P(OCXDT," ",2)) S OCXDT=OCXMON_" "_$P($P(OCXDT," ",1),"/",2)_","_$P($P(OCXDT," ",1),"/",3)_"@"_$TR($P(OCXDT," ",2),":","")
197 ;;R^"860.8:",100,25
198 ;;D^ ; .E S OCXDT=OCXMON_" "_$P($P(OCXDT," ",1),"/",2)_", "_$P($P(OCXDT," ",1),"/",3)
199 ;;R^"860.8:",100,26
200 ;;D^ ; ;
201 ;;R^"860.8:",100,27
202 ;;D^ ; I $L(OCXDT),'OCXDT D ; EXTERNAL FORMAT TO INTERNAL FILEMAN FORMAT
203 ;;R^"860.8:",100,28
204 ;;D^ ; .I (OCXDT["@0000") S OCXDT=$P(OCXDT,"@",1),OCXDIFF=1
205 ;;R^"860.8:",100,29
206 ;;D^ ; .N %DT,X,Y S X=OCXDT,%DT="" S:(OCXDT["@")!(OCXDT="N") %DT="T" D ^%DT S OCXDT=+Y
207 ;;R^"860.8:",100,30
208 ;;D^ ; ;
209 ;;R^"860.8:",100,31
210 ;;D^ ; I ($L(OCXDT\1)>7) S OCXDT=$$HL7TFM^XLFDT(OCXDT) ; HL7 FORMAT TO INTERNAL FILEMAN FORMAT
211 ;;R^"860.8:",100,32
212 ;;D^ ; ;
213 ;;R^"860.8:",100,33
214 ;;D^ ; I ($L(OCXDT\1)=7) S OCXDT=$$FMTH^XLFDT(+OCXDT) ; INTERNAL FILEMAN FORMAT TO $H FORMAT
215 ;;R^"860.8:",100,34
216 ;;D^ ; ;
217 ;;R^"860.8:",100,35
218 ;;D^ ; I (OCXDT?5N1","1.5N) S OCXVAL=(OCXDT*86400)+$P(OCXDT,",",2) ; $H FORMAT TO EXPERT SYSTEM INTERNAL FORMAT
219 ;;R^"860.8:",100,36
220 ;;D^ ; ;
221 ;;R^"860.8:",100,37
222 ;;D^ ; Q OCXVAL
223 ;;R^"860.8:",100,38
224 ;;D^ ; ;
225 ;;EOR^
226 ;;KEY^860.8:^CONVERT DATE FROM OCX FORMAT TO READABLE FORMAT
227 ;;R^"860.8:",.01,"E"
228 ;;D^CONVERT DATE FROM OCX FORMAT TO READABLE FORMAT
229 ;;R^"860.8:",.02,"E"
230 ;;D^INT2DT
231 ;;R^"860.8:",1,1
232 ;;D^ ;INT2DT(OCXDT,OCXF) ; This Local Extrinsic Function converts an OCX internal format
233 ;;R^"860.8:",1,2
234 ;;D^ ; ; date into an Externl Format (Human Readable) date. 'OCXF=SHORT FORMAT OCXF=LONG FORMAT
235 ;;R^"860.8:",1,3
236 ;;D^ ; ;
237 ;;R^"860.8:",100,1
238 ;;D^ ;INT2DT(OCXDT,OCXF) ; This Local Extrinsic Function converts an OCX internal format
239 ;;R^"860.8:",100,2
240 ;;D^ ; ; date into an Externl Format (Human Readable) date. 'OCXF=SHORT FORMAT OCXF=LONG FORMAT
241 ;;R^"860.8:",100,3
242 ;;D^ ; ;
243 ;;R^"860.8:",100,4
244 ;;D^ ; Q:'$L($G(OCXDT)) "" S OCXF=+$G(OCXF)
245 ;1;
246 ;
Note: See TracBrowser for help on using the repository browser.