source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXOZ09.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 7.7 KB
Line 
1OCXOZ09 ;SLC/RJS,CLA - Order Check Scan ;SEP 4,2007 at 23:12
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,221**;Dec 17,1997
3 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
4 ;
5 ; ***************************************************************
6 ; ** Warning: This routine is automatically generated by the **
7 ; ** Rule Compiler (^OCXOCMP) and ANY changes to this routine **
8 ; ** will be lost the next time the rule compiler executes. **
9 ; ***************************************************************
10 ;
11 Q
12 ;
13CHK188 ; Look through the current environment for valid Event/Elements for this patient.
14 ; Called from CHK58+19^OCXOZ05.
15 ;
16 Q:$G(OCXOERR)
17 ;
18 ; Local CHK188 Variables
19 ; OCXDF(2) ----> Data Field: FILLER (FREE TEXT)
20 ; OCXDF(40) ---> Data Field: ORDER MODE (FREE TEXT)
21 ; OCXDF(47) ---> Data Field: OI LOCAL TEXT (FREE TEXT)
22 ;
23 ; Local Extrinsic Functions
24 ; CLIST( -----------> STRING CONTAINS ONE OF A LIST OF VALUES
25 ; EQTERM( ----------> EQUALS TERM OPERATOR
26 ;
27 I $$EQTERM(OCXDF(47),"ANGIOGRAM (PERIPHERAL)") S OCXDF(40)=$G(OCXPSM) I $L(OCXDF(40)),(OCXDF(40)="SESSION") D CHK192
28 I $$CLIST(OCXDF(47),"GLUCOPHAGE,METFORMIN") S OCXDF(40)=$G(OCXPSM) I $L(OCXDF(40)),(OCXDF(40)="SELECT") S OCXDF(2)=$P($G(OCXPSD),"|",2) I $L(OCXDF(2)) D CHK280^OCXOZ0B
29 Q
30 ;
31CHK192 ; Look through the current environment for valid Event/Elements for this patient.
32 ; Called from CHK188+14.
33 ;
34 Q:$G(OCXOERR)
35 ;
36 ; Local CHK192 Variables
37 ; OCXDF(68) ---> Data Field: MISSING ANGIOGRAM, CATH PERIF LAB TESTS (FREE TEXT)
38 ;
39 ; Local Extrinsic Functions
40 ; FILE(DFN,65, -----> FILE DATA IN PATIENT ACTIVE DATA FILE (Event/Element: SESSION ORDER FOR ANGIOGRAM)
41 ; MTSTF( -----------> MISSING TESTS DURING SESSION
42 ;
43 S OCXDF(68)=$$MTSTF("PROTHROMBIN TIME,PARTIAL THROMBOPLASTIN TIME") I $L(OCXDF(68)),($L(OCXDF(68))>0) S OCXOERR=$$FILE(DFN,65,"68") Q:OCXOERR
44 Q
45 ;
46CHK196 ; Look through the current environment for valid Event/Elements for this patient.
47 ; Called from CHK163+13^OCXOZ07.
48 ;
49 Q:$G(OCXOERR)
50 ;
51 ; Local CHK196 Variables
52 ; OCXDF(2) ----> Data Field: FILLER (FREE TEXT)
53 ; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC)
54 ; OCXDF(67) ---> Data Field: CONTRAST MEDIA CODE (FREE TEXT)
55 ; OCXDF(73) ---> Data Field: ORDERABLE ITEM IEN (NUMERIC)
56 ; OCXDF(156) --> Data Field: ALLERGY ASSESSMENT (BOOLEAN)
57 ;
58 ; Local Extrinsic Functions
59 ; ALRGY( -----------> ALLERGY ASSESSMENT
60 ; CLIST( -----------> STRING CONTAINS ONE OF A LIST OF VALUES
61 ; FILE(DFN,136, ----> FILE DATA IN PATIENT ACTIVE DATA FILE (Event/Element: NO ALLERGY ASSESSMENT)
62 ;
63 S OCXDF(2)=$P($G(OCXPSD),"|",2) I $L(OCXDF(2)) D CHK198
64 S OCXDF(73)=$P($G(OCXPSD),"|",1) I $L(OCXDF(73)) S OCXDF(67)=$$CM^ORQQRA(OCXDF(73)) I $L(OCXDF(67)),$$CLIST(OCXDF(67),"M,I,N") S OCXDF(37)=$G(DFN) I $L(OCXDF(37)) D CHK466^OCXOZ0F
65 S OCXDF(37)=$G(DFN) I $L(OCXDF(37)) S OCXDF(156)=$$ALRGY(OCXDF(37)) I $L(OCXDF(156)),'(OCXDF(156)) S OCXOERR=$$FILE(DFN,136,"") Q:OCXOERR
66 Q
67 ;
68CHK198 ; Look through the current environment for valid Event/Elements for this patient.
69 ; Called from CHK196+17.
70 ;
71 Q:$G(OCXOERR)
72 ;
73 ; Local CHK198 Variables
74 ; OCXDF(2) ----> Data Field: FILLER (FREE TEXT)
75 ;
76 I (OCXDF(2)="RA") D CHK199
77 I ($E(OCXDF(2),1,2)="PS") D CHK362^OCXOZ0D
78 Q
79 ;
80CHK199 ; Look through the current environment for valid Event/Elements for this patient.
81 ; Called from CHK198+8.
82 ;
83 Q:$G(OCXOERR)
84 ;
85 ; Local CHK199 Variables
86 ; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC)
87 ; OCXDF(73) ---> Data Field: ORDERABLE ITEM IEN (NUMERIC)
88 ;
89 S OCXDF(37)=$G(DFN) I $L(OCXDF(37)) D CHK201
90 S OCXDF(73)=$P($G(OCXPSD),"|",1) I $L(OCXDF(73)) D CHK236^OCXOZ0A
91 Q
92 ;
93CHK201 ; Look through the current environment for valid Event/Elements for this patient.
94 ; Called from CHK199+9.
95 ;
96 Q:$G(OCXOERR)
97 ;
98 ; Local CHK201 Variables
99 ; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC)
100 ; OCXDF(65) ---> Data Field: CONTRAST MEDIA ALLERGY FLAG (BOOLEAN)
101 ; OCXDF(67) ---> Data Field: CONTRAST MEDIA CODE (FREE TEXT)
102 ; OCXDF(69) ---> Data Field: RECENT BARIUM STUDY FLAG (BOOLEAN)
103 ; OCXDF(73) ---> Data Field: ORDERABLE ITEM IEN (NUMERIC)
104 ;
105 ; Local Extrinsic Functions
106 ; RECBAR( ----------> RECENT BARIUM STUDY
107 ;
108 S OCXDF(65)=$$ORCHK^GMRAOR(OCXDF(37),"CM","") I $L(OCXDF(65)),(OCXDF(65)) S OCXDF(73)=$P($G(OCXPSD),"|",1) I $L(OCXDF(73)) S OCXDF(67)=$$CM^ORQQRA(OCXDF(73)) D CHK207
109 S OCXDF(69)=$P($$RECBAR(OCXDF(37),48),"^",1) I $L(OCXDF(69)),(OCXDF(69)) S OCXDF(73)=$P($G(OCXPSD),"|",1) I $L(OCXDF(73)) S OCXDF(67)=$$CM^ORQQRA(OCXDF(73)) D CHK217^OCXOZ0A
110 Q
111 ;
112CHK207 ; Look through the current environment for valid Event/Elements for this patient.
113 ; Called from CHK201+15.
114 ;
115 Q:$G(OCXOERR)
116 ;
117 ; Local CHK207 Variables
118 ; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC)
119 ; OCXDF(66) ---> Data Field: CONTRAST MEDIA CODE TRANSLATION (FREE TEXT)
120 ; OCXDF(67) ---> Data Field: CONTRAST MEDIA CODE (FREE TEXT)
121 ; OCXDF(159) --> Data Field: ALLERGY CONTRAST MEDIA LOCATION (FREE TEXT)
122 ;
123 ; Local Extrinsic Functions
124 ; CLIST( -----------> STRING CONTAINS ONE OF A LIST OF VALUES
125 ; CONTRANS( --------> CONTRAST MEDIA CODE TRANSLATION
126 ;
127 I $L(OCXDF(67)),$$CLIST(OCXDF(67),"M,I,N,L,C,G,B") S OCXDF(66)=$$CONTRANS(OCXDF(67)),OCXDF(159)=$P($$ORCHK^GMRAOR(OCXDF(37),"CM","",1),"^",2) D CHK211
128 Q
129 ;
130CHK211 ; Look through the current environment for valid Event/Elements for this patient.
131 ; Called from CHK207+15.
132 ;
133 Q:$G(OCXOERR)
134 ;
135 ; Local Extrinsic Functions
136 ; FILE(DFN,66, -----> FILE DATA IN PATIENT ACTIVE DATA FILE (Event/Element: CONTRAST MEDIA ALLERGY)
137 ;
138 S OCXOERR=$$FILE(DFN,66,"66,159") Q:OCXOERR
139 Q
140 ;
141ALRGY(ORPT) ; determine if pt has an allergy assessment
142 ; rtn 0 if no allergy assessment, 1 if allergy assessment or NKA
143 N ORALRGY
144 D EN1^GMRAOR1(ORPT,"ORALRGY")
145 Q:$G(ORALRGY)="" 0
146 Q 1
147 ;
148CLIST(DATA,LIST) ; DOES THE DATA FIELD CONTAIN AN ELEMENT IN THE LIST
149 ;
150 N PC F PC=1:1:$L(LIST,","),0 I PC,$L($P(LIST,",",PC)),(DATA[$P(LIST,",",PC)) Q
151 Q ''PC
152 ;
153CONTRANS(OCXC) ; Compiler Function: CONTRAST MEDIA CODE TRANSLATION
154 ;
155 N OCXX
156 Q:'$L($G(OCXC)) "" S OCXX=$S((OCXC["B"):"Barium",1:"")
157 I (OCXC["G") S:$L(OCXX) OCXX=OCXX_" and/or " S OCXX=OCXX_"Gastrografin"
158 I (OCXC["I") S:$L(OCXX) OCXX=OCXX_" and/or " S OCXX=OCXX_"Ionic Iodinated"
159 I (OCXC["N") S:$L(OCXX) OCXX=OCXX_" and/or " S OCXX=OCXX_"Non-ionic Iodinated"
160 I (OCXC["L") S:$L(OCXX) OCXX=OCXX_" and/or " S OCXX=OCXX_"Gadolinium"
161 I (OCXC["C") S:$L(OCXX) OCXX=OCXX_" and/or " S OCXX=OCXX_"Cholecystographic"
162 I (OCXC["M") S:$L(OCXX) OCXX=OCXX_" and/or " S OCXX=OCXX_"Unspecified contrast media"
163 Q OCXX
164 ;
165EQTERM(DATA,TERM) ; Compiler Function: EQUALS TERM OPERATOR
166 ;
167 N OCXF,OCXL
168 ;
169 S OCXL="",OCXF=$$TERMLKUP(TERM,.OCXL)
170 Q:'OCXF 0
171 I ($D(OCXL(DATA))!$D(OCXL("B",DATA))) Q 1
172 Q 0
173 ;
174FILE(DFN,OCXELE,OCXDFL) ; This Local Extrinsic Function logs a validated event/element.
175 ;
176 N OCXTIMN,OCXTIML,OCXTIMT1,OCXTIMT2,OCXDATA,OCXPC,OCXPC,OCXVAL,OCXSUB,OCXDFI
177 S DFN=+$G(DFN),OCXELE=+$G(OCXELE)
178 ;
179 Q:'DFN 1 Q:'OCXELE 1 K OCXDATA
180 ;
181 S OCXDATA(DFN,OCXELE)=1
182 F OCXPC=1:1:$L(OCXDFL,",") S OCXDFI=$P(OCXDFL,",",OCXPC) I OCXDFI D
183 .S OCXVAL=$G(OCXDF(+OCXDFI)),OCXDATA(DFN,OCXELE,+OCXDFI)=OCXVAL
184 ;
185 M ^TMP("OCXCHK",$J,DFN)=OCXDATA(DFN)
186 ;
187 Q 0
188 ;
189MTSTF(OILIST) ; Compiler Function: MISSING TESTS DURING SESSION
190 ;
191 N OCXPC,OCXOI,OCXOUT S OCXOUT=""
192 F OCXPC=1:1:$L(OILIST,",") S OCXOI=$P(OILIST,",",OCXPC) I $L(OCXOI) D
193 .N OCXL,OCXF,OCXD0
194 .S OCXL="",OCXF=$$TERMLKUP(OCXOI,.OCXL)
195 .S OCXD0=0 F S OCXD0=$O(OCXL(OCXD0)) Q:'OCXD0 Q:$$OISESS^ORKCHK2(+OCXD0)
196 .Q:OCXD0
197 .S:$L(OCXOUT) OCXOUT=OCXOUT_", " S OCXOUT=OCXOUT_OCXOI
198 Q OCXOUT
199 ;
200RECBAR(DFN,HOURS) ; Compiler Function: RECENT BARIUM STUDY
201 ;
202 Q:'$G(DFN) 0 Q:'$G(HOURS) 0 N OUT S OUT=$$RECENTBA^ORKRA(DFN,HOURS) Q:'$L(OUT) 0 Q 1_U_OUT
203 ;
204 ;
205TERMLKUP(OCXTERM,OCXLIST) ;
206 Q $$TERM^OCXOZ01(OCXTERM,.OCXLIST)
207 ;
Note: See TracBrowser for help on using the repository browser.