source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXDI02E.m@ 700

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

initial load of WorldVistAEHR

File size: 5.0 KB
RevLine 
[613]1OCXDI02E ;SLC/RJS,CLA - OCX PACKAGE DIAGNOSTIC ROUTINES ;SEP 7,1999 at 10:30
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
3 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
4 ;
5S ;
6 ;
7 D DOT^OCXDIAG
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("OCXDIAG",$J,$O(^TMP("OCXDIAG",$J,"A"),-1)+1)=TEXT
13 ;
14 G ^OCXDI02F
15 ;
16 Q
17 ;
18DATA ;
19 ;
20 ;;R^"860.8:",100,5
21 ;;D^ ; F OCXTERM="SERUM CREATININE","SERUM UREA NITROGEN" D Q:$L(OCXV)
22 ;;R^"860.8:",100,6
23 ;;D^ ; .Q:'$$TERMLKUP(OCXTERM,.OCXTL) ""
24 ;;R^"860.8:",100,7
25 ;;D^ ; .S OCXX=0 F S OCXX=$O(OCXTL(OCXX)) Q:'OCXX D Q:$L(OCXV)
26 ;;R^"860.8:",100,8
27 ;;D^ ; ..S OCXS=0 F S OCXS=$O(OCXSLIST(OCXS)) Q:'OCXS D Q:$L(OCXV)
28 ;;R^"860.8:",100,9
29 ;;D^ ; ...S OCXV=$$OIRES^ORQQLR1(DFN,OCXX,OCXS)
30 ;;R^"860.8:",100,10
31 ;;D^ ; Q OCXV
32 ;;R^"860.8:",100,11
33 ;;D^ ;
34 ;;EOR^
35 ;;KEY^860.8:^DETERMINE IF RENAL LAB RESULTS ARE ABNORMAL HIGH OR LOW
36 ;;R^"860.8:",.01,"E"
37 ;;D^DETERMINE IF RENAL LAB RESULTS ARE ABNORMAL HIGH OR LOW
38 ;;R^"860.8:",.02,"E"
39 ;;D^ABREN
40 ;;R^"860.8:",100,1
41 ;;D^ ;ABREN(DFN) ;
42 ;;R^"860.8:",100,2
43 ;;D^ ; ;
44 ;;R^"860.8:",100,3
45 ;;D^ ; N OCXFLAG,OCXVAL,OCXLIST,OCXTEST,UNAV,OCXTLIST,OCXTERM,OCXSLIST,OCXSPEC
46 ;;R^"860.8:",100,4
47 ;;D^ ; S (OCXLIST,OCXTLIST)="",UNAV="0^<Unavailable>"
48 ;;R^"860.8:",100,5
49 ;;D^ ; S OCXSLIST="" Q:'$$TERMLKUP("SERUM SPECIMEN",.OCXSLIST) UNAV
50 ;;R^"860.8:",100,6
51 ;;D^ ; F OCXTERM="SERUM CREATININE","SERUM UREA NITROGEN" D
52 ;;R^"860.8:",100,7
53 ;;D^ ; .Q:'$$TERMLKUP(OCXTERM,.OCXTLIST)
54 ;;R^"860.8:",100,8
55 ;;D^ ; .S OCXTEST=0 F S OCXTEST=$O(OCXTLIST(OCXTEST)) Q:'OCXTEST D
56 ;;R^"860.8:",100,9
57 ;;D^ ; ..S OCXSPEC=0 F S OCXSPEC=$O(OCXSLIST(OCXSPEC)) Q:'OCXSPEC D
58 ;;R^"860.8:",100,10
59 ;;D^ ; ...S OCXVAL=$$LOCL^ORQQLR1(DFN,OCXTEST,OCXSPEC),OCXFLAG=$P(OCXVAL,U,5)
60 ;;R^"860.8:",100,11
61 ;;D^ ; ...I $L(OCXVAL),((OCXFLAG["H")!(OCXFLAG["L")) D
62 ;;R^"860.8:",100,12
63 ;;D^ ; ....N OCXY S OCXY=""
64 ;;R^"860.8:",100,13
65 ;;D^ ; ....S OCXY=$P(OCXVAL,U,2)_": "_$P(OCXVAL,U,3)_" "_$P(OCXVAL,U,4)
66 ;;R^"860.8:",100,14
67 ;;D^ ; ....S OCXY=OCXY_" "_$S($L(OCXFLAG):"["_OCXFLAG_"]",1:"")
68 ;;R^"860.8:",100,15
69 ;;D^ ; ....S OCXY=OCXY_" "_$$FMTE^XLFDT($P(OCXVAL,U,7),"2P")
70 ;;R^"860.8:",100,16
71 ;;D^ ; ....S:$L(OCXLIST) OCXLIST=OCXLIST_" " S OCXLIST=OCXLIST_OCXY
72 ;;R^"860.8:",100,17
73 ;;D^ ; Q:'$L(OCXLIST) UNAV Q 1_U_OCXLIST
74 ;;R^"860.8:",100,18
75 ;;D^ ; ;
76 ;;EOR^
77 ;;KEY^860.8:^DOES THIS RADIOLOGY PROCEDURE USE A CONTRAST MEDIA
78 ;;R^"860.8:",.01,"E"
79 ;;D^DOES THIS RADIOLOGY PROCEDURE USE A CONTRAST MEDIA
80 ;;R^"860.8:",.02,"E"
81 ;;D^CM
82 ;;R^"860.8:",100,1
83 ;;D^ ;CM(OCXOI) ;
84 ;;R^"860.8:",100,2
85 ;;D^ ; ;
86 ;;R^"860.8:",100,3
87 ;;D^ ; N OCXVAL S OCXVAL=$$CM^ORQQRA(OCXOI) Q:((OCXVAL["B")!(OCXVAL["M")) 1_U_OCXVAL Q 0
88 ;;R^"860.8:",100,4
89 ;;D^ ; ;
90 ;;EOR^
91 ;;KEY^860.8:^IS THIS A CHOLECYSTOGRAM RADIOLOGY PROCEDURE
92 ;;R^"860.8:",.01,"E"
93 ;;D^IS THIS A CHOLECYSTOGRAM RADIOLOGY PROCEDURE
94 ;;R^"860.8:",.02,"E"
95 ;;D^CH
96 ;;R^"860.8:",100,1
97 ;;D^ ;CH(OCXOI) ;
98 ;;R^"860.8:",100,2
99 ;;D^ ; ;
100 ;;R^"860.8:",100,3
101 ;;D^ ; N OCXVAL S OCXVAL=$$CM^ORQQRA(OCXOI) Q:(OCXVAL["C") 1_U_OCXVAL Q 0
102 ;;R^"860.8:",100,4
103 ;;D^ ; ;
104 ;;EOR^
105 ;;KEY^860.8:^GET DATA FROM THE ACTIVE DATA FILE
106 ;;R^"860.8:",.01,"E"
107 ;;D^GET DATA FROM THE ACTIVE DATA FILE
108 ;;R^"860.8:",.02,"E"
109 ;;D^GETDATA
110 ;;R^"860.8:",100,1
111 ;;D^ ;GETDATA(DFN,OCXL,OCXDFI) ; This Local Extrinsic Function returns runtime data
112 ;;R^"860.8:",100,2
113 ;;D^ ; ;
114 ;;R^"860.8:",100,3
115 ;;D^ ; N OCXE,VAL,PC S VAL=""
116 ;;R^"860.8:",100,4
117 ;;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)
118 ;;R^"860.8:",100,5
119 ;;D^ ; Q VAL
120 ;;R^"860.8:",100,6
121 ;;D^ ; ;
122 ;;EOR^
123 ;;KEY^860.8:^DATE PATIENT DECEASED
124 ;;R^"860.8:",.01,"E"
125 ;;D^DATE PATIENT DECEASED
126 ;;R^"860.8:",.02,"E"
127 ;;D^DECEASED
128 ;;EOR^
129 ;;KEY^860.8:^SITE FLAGGED ORDER
130 ;;R^"860.8:",.01,"E"
131 ;;D^SITE FLAGGED ORDER
132 ;;R^"860.8:",.02,"E"
133 ;;D^SITEORD
134 ;;R^"860.8:",100,1
135 ;;D^ ;SITEORD(ORNUM) ;Ext. funct return 1 (Yes) or 0 (No) if the site has flagged the
136 ;;R^"860.8:",100,2
137 ;;D^ ; ; orderable item (determined via order number ORNUM) to trigger a
138 ;;R^"860.8:",100,3
139 ;;D^ ; ; notification when ordered
140 ;;R^"860.8:",100,4
141 ;;D^ ; N ORBFLAG,OI S ORBFLAG="",OI=""
142 ;;R^"860.8:",100,5
143 ;;D^T+; W:$G(OCXTRACE) !!,"Site Flagged Order function, ORNUM: ",ORNUM
144 ;;R^"860.8:",100,6
145 ;;D^ ; Q:'$L($G(ORNUM)) ORBFLAG
146 ;;R^"860.8:",100,7
147 ;;D^ ; S OI=$$OI^ORQOR2(ORNUM)
148 ;;R^"860.8:",100,8
149 ;;D^ ; Q:'$L($G(OI)) ORBFLAG
150 ;;R^"860.8:",100,9
151 ;;D^ ; S ORBFLAG=$$GET^XPAR("ALL","ORB ORDERABLE ITEM ORDERED","`"_OI,"Q")
152 ;;R^"860.8:",100,10
153 ;;D^T+; W:$G(OCXTRACE) !," Results (ORBFLAG): ",ORBFLAG,!!
154 ;;R^"860.8:",100,11
155 ;;D^ ; Q ORBFLAG
156 ;;R^"860.8:",100,12
157 ;;D^ ; ;
158 ;;EOR^
159 ;;KEY^860.8:^SITE FLAGGED RESULT
160 ;;R^"860.8:",.01,"E"
161 ;;D^SITE FLAGGED RESULT
162 ;;R^"860.8:",.02,"E"
163 ;;D^SITERES
164 ;;R^"860.8:",100,1
165 ;;D^ ;SITERES(ORNUM) ;Ext. funct return 1 (Yes) if the site has flagged the
166 ;1;
167 ;
Note: See TracBrowser for help on using the repository browser.