source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORY14406.m@ 1552

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

initial load of FOIAVistA 6/30/08 version

File size: 7.2 KB
Line 
1ORY14406 ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Install of OR*3*144) ;JUN 12,2002 at 12:20
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**144**;Dec 17,1997
3 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
4 ;
5S ;
6 ;
7 D DOT^ORY144ES
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 ^ORY14407
15 ;
16 Q
17 ;
18DATA ;
19 ;
20 ;;R^"860.8:",100,54
21 ;;D^ ; ..N OCXGR2
22 ;;R^"860.8:",100,55
23 ;;D^ ; ..S OCXGR2=OCXGR1_","_OCXELE_",1"
24 ;;R^"860.8:",100,56
25 ;;D^ ; ..K OCXDATA
26 ;;R^"860.8:",100,57
27 ;;D^ ; ..S OCXDATA(OCXDFI,0)=OCXDFI
28 ;;R^"860.8:",100,58
29 ;;D^ ; ..S OCXDATA(OCXDFI,"VAL")=^TMP("OCXCHK",$J,OCXDFN,OCXELE,OCXDFI)
30 ;;R^"860.8:",100,59
31 ;;D^ ; ..S OCXDATA("B",OCXDFI,OCXDFI)=""
32 ;;R^"860.8:",100,60
33 ;;D^T+; ..D SETAP(OCXGR2_")","860.71223P","Data Field",$P($G(^OCXS(860.4,OCXDFI,0)),U,1),.OCXDATA,OCXDFI)
34 ;;R^"860.8:",100,61
35 ;;D^T-; ..D SETAP(OCXGR2_")","860.71223P",.OCXDATA,OCXDFI)
36 ;;R^"860.8:",100,62
37 ;;D^ ; ;
38 ;;R^"860.8:",100,63
39 ;;D^ ; Q 1
40 ;;R^"860.8:",100,64
41 ;;D^ ; ;
42 ;;R^"860.8:",100,65
43 ;;D^T+;SETAP(ROOT,DD,ITEM,ITEMNAME,DATA,DA) ; Set Rule Event data
44 ;;R^"860.8:",100,66
45 ;;D^T-;SETAP(ROOT,DD,DATA,DA) ; Set Rule Event data
46 ;;R^"860.8:",100,67
47 ;;D^ ; M @ROOT=DATA
48 ;;R^"860.8:",100,68
49 ;;D^ ; I +$G(DD) S @ROOT@(0)="^"_($G(DD))_"^"_($P($G(@ROOT@(0)),U,3)+1)_"^"_$G(DA)
50 ;;R^"860.8:",100,69
51 ;;D^ ; I '$G(DD) S $P(@ROOT@(0),U,3,4)=($P($G(@ROOT@(0)),U,3)+1)_"^"_$G(DA)
52 ;;R^"860.8:",100,70
53 ;;D^T+; W:$G(OCXTRACE) !,"File Active Data ",$G(ITEM),": ",$G(ITEMNAME)
54 ;;R^"860.8:",100,71
55 ;;D^ ; ;
56 ;;R^"860.8:",100,72
57 ;;D^ ; Q
58 ;;R^"860.8:",100,73
59 ;;D^ ; ;
60 ;;R^"860.8:",100,74
61 ;;D^ ; ;
62 ;;EOR^
63 ;;KEY^860.8:^ORDERABLE ITEM
64 ;;R^"860.8:",.01,"E"
65 ;;D^ORDERABLE ITEM
66 ;;R^"860.8:",.02,"E"
67 ;;D^OI
68 ;;R^"860.8:",1,1
69 ;;D^Extrinsic function returns the orderable item for an order number.
70 ;;R^"860.8:",100,1
71 ;;D^ ;OI(OCXOR) ;func rtns orderable item for an order number (OCXOR)
72 ;;R^"860.8:",100,2
73 ;;D^ ; Q:+$G(OCXOR)<1 ""
74 ;;R^"860.8:",100,3
75 ;;D^ ; N OCXOI S OCXOI=""
76 ;;R^"860.8:",100,4
77 ;;D^ ; S OCXOI=+$G(^OR(100,+$G(OCXOR),.1,1,0))
78 ;;R^"860.8:",100,5
79 ;;D^ ; Q OCXOI
80 ;;R^"860.8:",100,6
81 ;;D^ ; ;
82 ;;EOR^
83 ;;KEY^860.8:^RECENT CREATININE LAB PROCEDURE
84 ;;R^"860.8:",.01,"E"
85 ;;D^RECENT CREATININE LAB PROCEDURE
86 ;;R^"860.8:",.02,"E"
87 ;;D^RECCREAT
88 ;;R^"860.8:",100,1
89 ;;D^ ;RECCREAT(ORDFN,ORDAYS) ;extrinsic function to return most recent
90 ;;R^"860.8:",100,2
91 ;;D^ ; ;SERUM CREATININE within <ORDAYS> in format:
92 ;;R^"860.8:",100,3
93 ;;D^ ; ; test id^result units flag ref range collection d/t
94 ;;R^"860.8:",100,4
95 ;;D^ ; N BDT,CDT,ORY,ORX,ORZ,X,ORI,ORJ,CREARSLT,LABFILE,SPECFILE
96 ;;R^"860.8:",100,5
97 ;;D^ ; Q:'$L($G(ORDFN)) "0^"
98 ;;R^"860.8:",100,6
99 ;;D^ ; Q:'$L($G(ORDAYS)) "0^"
100 ;;R^"860.8:",100,7
101 ;;D^ ; D NOW^%DTC
102 ;;R^"860.8:",100,8
103 ;;D^ ; S BDT=$$FMADD^XLFDT(%,"-"_ORDAYS,"","","")
104 ;;R^"860.8:",100,9
105 ;;D^ ; K %
106 ;;R^"860.8:",100,10
107 ;;D^ ; Q:'$L($G(BDT)) "0^"
108 ;;R^"860.8:",100,11
109 ;;D^ ; S LABFILE=$$TERMLKUP("SERUM CREATININE",.ORY)
110 ;;R^"860.8:",100,12
111 ;;D^ ; Q:$G(LABFILE)'=60 "0^"
112 ;;R^"860.8:",100,13
113 ;;D^ ; Q:+$D(ORY)<1 "0^"
114 ;;R^"860.8:",100,14
115 ;;D^ ; S SPECFILE=$$TERMLKUP("SERUM SPECIMEN",.ORX)
116 ;;R^"860.8:",100,15
117 ;;D^ ; Q:$G(SPECFILE)'=61 "0^"
118 ;;R^"860.8:",100,16
119 ;;D^ ; Q:+$D(ORX)<1 "0^"
120 ;;R^"860.8:",100,17
121 ;;D^ ; S ORI=0 F S ORI=$O(ORY(ORI)) Q:'ORI I +$G(CREARSLT)<1 D
122 ;;R^"860.8:",100,18
123 ;;D^ ; .S ORJ=0 F S ORJ=$O(ORX(ORJ)) Q:'ORJ I +$G(CREARSLT)<1 D
124 ;;R^"860.8:",100,19
125 ;;D^ ; ..S ORZ=$$LOCL^ORQQLR1(ORDFN,ORI,ORJ)
126 ;;R^"860.8:",100,20
127 ;;D^ ; ..Q:'$L($G(ORZ))
128 ;;R^"860.8:",100,21
129 ;;D^ ; ..S CDT=$P(ORZ,U,7)
130 ;;R^"860.8:",100,22
131 ;;D^ ; ..I CDT'<BDT S CREARSLT=1
132 ;;R^"860.8:",100,23
133 ;;D^ ; Q:+$G(CREARSLT)<1 "0^"
134 ;;R^"860.8:",100,24
135 ;;D^ ; Q $P(ORZ,U)_U_$P(ORZ,U,3)_" "_$P(ORZ,U,4)_" "_$P(ORZ,U,5)_" ("_$P(ORZ,U,6)_") "_$$FMTE^XLFDT(CDT,"2P")_U_$P(ORZ,U,3)
136 ;;EOR^
137 ;;KEY^860.8:^RETURN POINTED TO VALUE
138 ;;R^"860.8:",.01,"E"
139 ;;D^RETURN POINTED TO VALUE
140 ;;R^"860.8:",.02,"E"
141 ;;D^POINTER
142 ;;R^"860.8:",1,1
143 ;;D^ ;POINTER(OCXFILE,D0) ; This Local Extrinsic Function gets the value of the name field
144 ;;R^"860.8:",1,2
145 ;;D^ ; ; of record D0 in file OCXFILE
146 ;;R^"860.8:",100,1
147 ;;D^ ;POINTER(OCXFILE,D0) ; This Local Extrinsic Function gets the value of the name field
148 ;;R^"860.8:",100,2
149 ;;D^ ; ; of record D0 in file OCXFILE
150 ;;R^"860.8:",100,3
151 ;;D^T+; I $G(OCXTRACE) W !,"%%%%",?20," FILE: ",$G(OCXFILE)," D0: ",$G(D0)
152 ;;R^"860.8:",100,4
153 ;;D^ ; Q:'$G(D0) "" Q:'$L($G(OCXFILE)) ""
154 ;;R^"860.8:",100,5
155 ;;D^ ; N GLREF
156 ;;R^"860.8:",100,6
157 ;;D^ ; I '(OCXFILE=(+OCXFILE)) S GLREF=U_OCXFILE
158 ;;R^"860.8:",100,7
159 ;;D^ ; E S GLREF=$$FILE^OCXBDTD(+OCXFILE,"GLOBAL NAME") Q:'$L(GLREF) ""
160 ;;R^"860.8:",100,8
161 ;;D^T+; I $G(OCXTRACE) W !,"%%%%",?20," GLREF: ",GLREF," RESOLVES TO: ",$P($G(@(GLREF_(+D0)_",0)")),U,1)
162 ;;R^"860.8:",100,9
163 ;;D^ ; Q $P($G(@(GLREF_(+D0)_",0)")),U,1)
164 ;;R^"860.8:",100,10
165 ;;D^ ; ;
166 ;;EOR^
167 ;;KEY^860.8:^STRING CONTAINS ONE OF A LIST OF VALUES
168 ;;R^"860.8:",.01,"E"
169 ;;D^STRING CONTAINS ONE OF A LIST OF VALUES
170 ;;R^"860.8:",.02,"E"
171 ;;D^CLIST
172 ;;R^"860.8:",100,1
173 ;;D^ ;CLIST(DATA,LIST) ; DOES THE DATA FIELD CONTAIN AN ELEMENT IN THE LIST
174 ;;R^"860.8:",100,2
175 ;;D^ ; ;
176 ;;R^"860.8:",100,3
177 ;;D^T+; W:$G(OCXTRACE) !!,"$$CLIST(",DATA,",""",LIST,""")"
178 ;;R^"860.8:",100,4
179 ;;D^ ; N PC F PC=1:1:$L(LIST,","),0 I PC,$L($P(LIST,",",PC)),(DATA[$P(LIST,",",PC)) Q
180 ;;R^"860.8:",100,5
181 ;;D^ ; Q ''PC
182 ;;EOR^
183 ;;EOF^OCXS(860.8)^1
184 ;;SOF^860.6 ORDER CHECK DATA CONTEXT
185 ;;KEY^860.6:^CPRS ORDER PROTOCOL
186 ;;R^"860.6:",.01,"E"
187 ;;D^CPRS ORDER PROTOCOL
188 ;;R^"860.6:",.02,"E"
189 ;;D^OERR
190 ;;R^"860.6:",1,"E"
191 ;;D^DATA DRIVEN
192 ;;EOR^
193 ;;KEY^860.6:^DATABASE LOOKUP
194 ;;R^"860.6:",.01,"E"
195 ;;D^DATABASE LOOKUP
196 ;;R^"860.6:",.02,"E"
197 ;;D^DL
198 ;;R^"860.6:",1,"E"
199 ;;D^PACKAGE LOOKUP
200 ;;EOR^
201 ;;KEY^860.6:^GENERIC HL7 MESSAGE ARRAY
202 ;;R^"860.6:",.01,"E"
203 ;;D^GENERIC HL7 MESSAGE ARRAY
204 ;;R^"860.6:",.02,"E"
205 ;;D^HL7
206 ;;R^"860.6:",1,"E"
207 ;;D^DATA DRIVEN
208 ;;EOR^
209 ;;EOF^OCXS(860.6)^1
210 ;;SOF^860.5 ORDER CHECK DATA SOURCE
211 ;;KEY^860.5:^DATABASE LOOKUP
212 ;;R^"860.5:",.01,"E"
213 ;;D^DATABASE LOOKUP
214 ;;R^"860.5:",.02,"E"
215 ;;D^DATABASE LOOKUP
216 ;;EOR^
217 ;;KEY^860.5:^HL7 OBSERVATION/RESULT SEGMENT
218 ;;R^"860.5:",.01,"E"
219 ;;D^HL7 OBSERVATION/RESULT SEGMENT
220 ;;R^"860.5:",.02,"E"
221 ;;D^GENERIC HL7 MESSAGE ARRAY
222 ;;EOR^
223 ;;KEY^860.5:^HL7 PATIENT ID SEGMENT
224 ;;R^"860.5:",.01,"E"
225 ;;D^HL7 PATIENT ID SEGMENT
226 ;;R^"860.5:",.02,"E"
227 ;;D^GENERIC HL7 MESSAGE ARRAY
228 ;;EOR^
229 ;;KEY^860.5:^OERR ORDER EVENT FLAG PROTOCOL
230 ;;R^"860.5:",.01,"E"
231 ;;D^OERR ORDER EVENT FLAG PROTOCOL
232 ;;R^"860.5:",.02,"E"
233 ;;D^CPRS ORDER PROTOCOL
234 ;;EOR^
235 ;;EOF^OCXS(860.5)^1
236 ;;SOF^860.4 ORDER CHECK DATA FIELD
237 ;;KEY^860.4:^LAB SPECIMEN ID
238 ;;R^"860.4:",.01,"E"
239 ;;D^LAB SPECIMEN ID
240 ;;R^"860.4:",1,"E"
241 ;;D^LAB SPEC ID
242 ;;R^"860.4:",101,"E"
243 ;;D^NUMERIC
244 ;;R^"860.4:","860.41:GENERIC HL7 MESSAGE ARRAY^860.6",.01,"E"
245 ;;D^GENERIC HL7 MESSAGE ARRAY
246 ;;R^"860.4:","860.41:GENERIC HL7 MESSAGE ARRAY^860.6",.02,"E"
247 ;;D^HL7 OBSERVATION/RESULT SEGMENT
248 ;;R^"860.4:","860.41:GENERIC HL7 MESSAGE ARRAY^860.6",1,"E"
249 ;;D^PATIENT.LAB_SPECIMEN_ID
250 ;;EOR^
251 ;;KEY^860.4:^LAB SPECIMEN NAME
252 ;;R^"860.4:",.01,"E"
253 ;1;
254 ;
Note: See TracBrowser for help on using the repository browser.