source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXDI02G.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 4.9 KB
Line 
1OCXDI02G ;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 ^OCXDI02H
15 ;
16 Q
17 ;
18DATA ;
19 ;
20 ;;R^"860.8:",100,3
21 ;;D^T+; I $G(OCXTRACE) W !,"%%%%",?20," Execution trace OILIST: ",$G(OILIST)
22 ;;R^"860.8:",100,4
23 ;;D^ ; N OCXPC,OCXOI,OCXOUT S OCXOUT=""
24 ;;R^"860.8:",100,5
25 ;;D^ ; F OCXPC=1:1:$L(OILIST,",") S OCXOI=$P(OILIST,",",OCXPC) I $L(OCXOI) D
26 ;;R^"860.8:",100,6
27 ;;D^ ; .N OCXL,OCXF,OCXD0
28 ;;R^"860.8:",100,7
29 ;;D^ ; .S OCXL="",OCXF=$$TERMLKUP(OCXOI,.OCXL)
30 ;;R^"860.8:",100,8
31 ;;D^ ; .S OCXD0=0 F S OCXD0=$O(OCXL(OCXD0)) Q:'OCXD0 Q:$$OISESS^ORKCHK2(+OCXD0)
32 ;;R^"860.8:",100,9
33 ;;D^ ; .Q:OCXD0
34 ;;R^"860.8:",100,10
35 ;;D^ ; .S:$L(OCXOUT) OCXOUT=OCXOUT_", " S OCXOUT=OCXOUT_OCXOI
36 ;;R^"860.8:",100,11
37 ;;D^ ; Q OCXOUT
38 ;;R^"860.8:",100,12
39 ;;D^ ; ;
40 ;;EOR^
41 ;;KEY^860.8:^RECENT BARIUM STUDY
42 ;;R^"860.8:",.01,"E"
43 ;;D^RECENT BARIUM STUDY
44 ;;R^"860.8:",.02,"E"
45 ;;D^RECBAR
46 ;;R^"860.8:",100,1
47 ;;D^ ;RECBAR(DFN,HOURS) ;
48 ;;R^"860.8:",100,2
49 ;;D^ ; ;
50 ;;R^"860.8:",100,3
51 ;;D^ ; Q:'$G(DFN) 0 Q:'$G(HOURS) 0 N OUT S OUT=$$RECENTBA^ORKRA(DFN,HOURS) Q:'$L(OUT) 0 Q 1_U_OUT
52 ;;R^"860.8:",100,4
53 ;;D^ ; ;
54 ;;EOR^
55 ;;KEY^860.8:^RECENT WBC LAB PROCEDURE
56 ;;R^"860.8:",.01,"E"
57 ;;D^RECENT WBC LAB PROCEDURE
58 ;;R^"860.8:",.02,"E"
59 ;;D^RECWBC
60 ;;R^"860.8:",100,1
61 ;;D^ ;RECWBC(DFN,DAYS) ;
62 ;;R^"860.8:",100,2
63 ;;D^ ; ;
64 ;;R^"860.8:",100,3
65 ;;D^ ; Q:'$G(DFN) 0
66 ;;R^"860.8:",100,4
67 ;;D^ ; N OUT S OUT=$$RECNTWBC^ORKLR(DFN,DAYS) Q:'OUT 0 Q OUT
68 ;;R^"860.8:",100,5
69 ;;D^ ; ;
70 ;;EOR^
71 ;;KEY^860.8:^CREATININE CLEARANCE (ESTIMATED/CALCULATED)
72 ;;R^"860.8:",.01,"E"
73 ;;D^CREATININE CLEARANCE (ESTIMATED/CALCULATED)
74 ;;R^"860.8:",.02,"E"
75 ;;D^CRCL
76 ;;R^"860.8:",100,1
77 ;;D^ ;CRCL(DFN) ;
78 ;;R^"860.8:",100,2
79 ;;D^ ; ;
80 ;;R^"860.8:",100,3
81 ;;D^ ; N WT,AGE,SEX,SCR,SCRD,CRCL,UNAV,OCXTL,OCXTLS,OCXT,OCXTS
82 ;;R^"860.8:",100,4
83 ;;D^ ; S UNAV="0^<Unavailable>"
84 ;;R^"860.8:",100,5
85 ;;D^ ; S WT=$P($$WT^ORQPTQ4(DFN),U,2)*.454 Q:'WT UNAV
86 ;;R^"860.8:",100,6
87 ;;D^ ; S AGE=$$AGE^ORQPTQ4(DFN) Q:'AGE UNAV
88 ;;R^"860.8:",100,7
89 ;;D^ ; S SEX=$P($$SEX^ORQPTQ4(DFN),U,1) Q:'$L(SEX) UNAV
90 ;;R^"860.8:",100,8
91 ;;D^ ; S OCXTL="" Q:'$$TERMLKUP("SERUM CREATININE",.OCXTL) UNAV
92 ;;R^"860.8:",100,9
93 ;;D^ ; S OCXTLS="" Q:'$$TERMLKUP("SERUM SPECIMEN",.OCXTLS) UNAV
94 ;;R^"860.8:",100,10
95 ;;D^ ; S SCR="",OCXT=0 F S OCXT=$O(OCXTL(OCXT)) Q:'OCXT D Q:$L(SCR)
96 ;;R^"860.8:",100,11
97 ;;D^ ; .S OCXTS=0 F S OCXTS=$O(OCXTLS(OCXTS)) Q:'OCXTS D Q:$L(SCR)
98 ;;R^"860.8:",100,12
99 ;;D^ ; ..S SCR=$$LOCL^ORQQLR1(DFN,OCXT,OCXTS)
100 ;;R^"860.8:",100,13
101 ;;D^ ; Q:'$L(SCR) UNAV S SCRV=$P(SCR,U,3) Q:'SCRV UNAV
102 ;;R^"860.8:",100,14
103 ;;D^ ; S SCRD=$P(SCR,U,7) Q:'$L(SCRD) UNAV
104 ;;R^"860.8:",100,15
105 ;;D^ ; ;
106 ;;R^"860.8:",100,16
107 ;;D^ ; S CRCL=(((140-AGE)*WT)/(SCRV*72))
108 ;;R^"860.8:",100,17
109 ;;D^ ; ;
110 ;;R^"860.8:",100,18
111 ;;D^ ; I (SEX="M") Q SCRD_U_$J(CRCL,1,2)
112 ;;R^"860.8:",100,19
113 ;;D^ ; I (SEX="F") Q SCRD_U_$J((CRCL*.85),1,2)
114 ;;R^"860.8:",100,20
115 ;;D^ ; Q UNAV
116 ;;R^"860.8:",100,21
117 ;;D^ ; ;
118 ;;EOR^
119 ;;KEY^860.8:^CT MRI PHYSICAL LIMITS
120 ;;R^"860.8:",.01,"E"
121 ;;D^CT MRI PHYSICAL LIMITS
122 ;;R^"860.8:",.02,"E"
123 ;;D^CTMRI
124 ;;R^"860.8:",100,1
125 ;;D^ ;CTMRI(DFN,OCXOI) ;
126 ;;R^"860.8:",100,2
127 ;;D^ ; ;
128 ;;R^"860.8:",100,3
129 ;;D^ ; N OCXDEV,OCXWTP,OCXHTP,OCXWTL,OCXHTL
130 ;;R^"860.8:",100,4
131 ;;D^ ; S OCXDEV=$$TYPE^ORKRA(OCXOI)
132 ;;R^"860.8:",100,5
133 ;;D^ ; Q:'((OCXDEV="MRI")!(OCXDEV="CT")) 0_U
134 ;;R^"860.8:",100,6
135 ;;D^ ; S OCXWTP=$P($$WT^ORQPTQ4(DFN),U,2),OCXHTP=$P($$HT^ORQPTQ4(DFN),U,2)
136 ;;R^"860.8:",100,7
137 ;;D^ ; I (OCXDEV="CT") S OCXWTL=$$GET^XPAR("ALL","ORK CT LIMIT WT",1,"Q"),OCXHTL=$$GET^XPAR("ALL","ORK CT LIMIT HT",1,"Q")
138 ;;R^"860.8:",100,8
139 ;;D^ ; I (OCXDEV="CT"),(OCXWTL),(OCXWTP>OCXWTL) Q 1_U_"too heavy"_U_"CT scanner"
140 ;;R^"860.8:",100,9
141 ;;D^ ; I (OCXDEV="CT"),(OCXHTL),(OCXHTP>OCXHTL) Q 1_U_"too tall"_U_"CT scanner"
142 ;;R^"860.8:",100,10
143 ;;D^ ; I (OCXDEV="MRI") S OCXWTL=$$GET^XPAR("ALL","ORK MRI LIMIT WT",1,"Q"),OCXHTL=$$GET^XPAR("ALL","ORK MRI LIMIT HT",1,"Q")
144 ;;R^"860.8:",100,11
145 ;;D^ ; I (OCXDEV="MRI"),(OCXWTL),(OCXWTP>OCXWTL) Q 1_U_"too heavy"_U_"MRI scanner"
146 ;;R^"860.8:",100,12
147 ;;D^ ; I (OCXDEV="MRI"),(OCXHTL),(OCXHTP>OCXHTL) Q 1_U_"too tall"_U_"MRI scanner"
148 ;;R^"860.8:",100,13
149 ;;D^ ; Q 0_U
150 ;;R^"860.8:",100,14
151 ;;D^ ; ;
152 ;;EOR^
153 ;;KEY^860.8:^GET ORDERABLE ITEM INTERNAL ENTRY NUMBER
154 ;;R^"860.8:",.01,"E"
155 ;;D^GET ORDERABLE ITEM INTERNAL ENTRY NUMBER
156 ;;R^"860.8:",.02,"E"
157 ;;D^GETOIIEN
158 ;;R^"860.8:",100,1
159 ;;D^ ;GETOIIEN(OCXPKG,OCXNAME) ;
160 ;;R^"860.8:",100,2
161 ;;D^ ; ;
162 ;;R^"860.8:",100,3
163 ;;D^ ; Q:'$L($G(OCXNAME)) 0 Q:'$L($G(OCXPKG)) 0 Q:'$D(^ORD(101.43,"S."_OCXPKG)) 0
164 ;;R^"860.8:",100,4
165 ;;D^ ; N OCXD0,OCXLIST,OCXOI
166 ;;R^"860.8:",100,5
167 ;1;
168 ;
Note: See TracBrowser for help on using the repository browser.