source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORY23404.m@ 1150

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

initial load of WorldVistAEHR
File size: 7.0 KB
Line 
1ORY23404 ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Install of OR*3*234) ;MAY 13,2005 at 09:31
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**234**;Dec 17,1997
3 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
4 ;
5S ;
6 ;
7 D DOT^ORY234ES
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 ^ORY23405
15 ;
16 Q
17 ;
18DATA ;
19 ;
20 ;;R^"860.8:",100,5
21 ;;D^ ; I (OCXC["G") S:$L(OCXX) OCXX=OCXX_" and/or " S OCXX=OCXX_"Gastrografin"
22 ;;R^"860.8:",100,6
23 ;;D^ ; I (OCXC["I") S:$L(OCXX) OCXX=OCXX_" and/or " S OCXX=OCXX_"Ionic Iodinated"
24 ;;R^"860.8:",100,7
25 ;;D^ ; I (OCXC["N") S:$L(OCXX) OCXX=OCXX_" and/or " S OCXX=OCXX_"Non-ionic Iodinated"
26 ;;R^"860.8:",100,8
27 ;;D^ ; I (OCXC["L") S:$L(OCXX) OCXX=OCXX_" and/or " S OCXX=OCXX_"Gadolinium"
28 ;;R^"860.8:",100,9
29 ;;D^ ; I (OCXC["C") S:$L(OCXX) OCXX=OCXX_" and/or " S OCXX=OCXX_"Cholecystographic"
30 ;;R^"860.8:",100,10
31 ;;D^ ; I (OCXC["M") S:$L(OCXX) OCXX=OCXX_" and/or " S OCXX=OCXX_"Unspecified contrast media"
32 ;;R^"860.8:",100,11
33 ;;D^ ; Q OCXX
34 ;;R^"860.8:",100,12
35 ;;D^ ; ;
36 ;;EOR^
37 ;;KEY^860.8:^CONVERT DATE FROM FILEMAN FORMAT TO OCX FORMAT
38 ;;R^"860.8:",.01,"E"
39 ;;D^CONVERT DATE FROM FILEMAN FORMAT TO OCX FORMAT
40 ;;R^"860.8:",.02,"E"
41 ;;D^DT2INT
42 ;;R^"860.8:",1,1
43 ;;D^ ;DT2INT(OCXDT) ; This Local Extrinsic Function converts a date into an integer
44 ;;R^"860.8:",1,2
45 ;;D^ ; ; By taking the Years, Months, Days, Hours and Minutes converting
46 ;;R^"860.8:",1,3
47 ;;D^ ; ; Them into Seconds and then adding them all together into one big integer
48 ;;R^"860.8:",100,1
49 ;;D^ ;DT2INT(OCXDT) ; This Local Extrinsic Function converts a date into an integer
50 ;;R^"860.8:",100,2
51 ;;D^ ; ; By taking the Years, Months, Days, Hours and Minutes converting
52 ;;R^"860.8:",100,3
53 ;;D^ ; ; Them into Seconds and then adding them all together into one big integer
54 ;;R^"860.8:",100,4
55 ;;D^ ; ;
56 ;;R^"860.8:",100,5
57 ;;D^ ; Q:'$L($G(OCXDT)) ""
58 ;;R^"860.8:",100,6
59 ;;D^ ; N OCXDIFF,OCXVAL S (OCXDIFF,OCXVAL)=0
60 ;;R^"860.8:",100,7
61 ;;D^ ; ;
62 ;;R^"860.8:",100,8
63 ;;D^ ; I $L(OCXDT),'OCXDT,(OCXDT[" at ") D ; EXTERNAL EXPERT SYSTEM FORMAT 1 TO EXTERNAL FORMAT
64 ;;R^"860.8:",100,9
65 ;;D^ ; .N OCXHR,OCXMIN,OCXTIME
66 ;;R^"860.8:",100,10
67 ;;D^ ; .S OCXTIME=$P($P(OCXDT," at ",2),".",1),OCXHR=$P(OCXTIME,":",1),OCXMIN=$P(OCXTIME,":",2)
68 ;;R^"860.8:",100,11
69 ;;D^ ; .S:(OCXDT["Midnight") OCXHR=00
70 ;;R^"860.8:",100,12
71 ;;D^ ; .S:(OCXDT["PM") OCXHR=OCXHR+12
72 ;;R^"860.8:",100,13
73 ;;D^ ; .S OCXDT=$P(OCXDT," at ")_"@"_$E(OCXHR+100,2,3)_$E(OCXMIN+100,2,3)
74 ;;R^"860.8:",100,14
75 ;;D^ ; ;
76 ;;R^"860.8:",100,15
77 ;;D^ ; I $L(OCXDT),(OCXDT?1.2N1"/"1.2N.1" ".2N.1":".2N) D ; EXTERNAL EXPERT SYSTEM FORMAT 2 TO EXTERNAL FORMAT
78 ;;R^"860.8:",100,16
79 ;;D^ ; .N OCXMON
80 ;;R^"860.8:",100,17
81 ;;D^ ; .S OCXMON=$P("January^February^March^April^May^June^July^August^September^October^November^December",U,$P(OCXDT,"/",1))
82 ;;R^"860.8:",100,18
83 ;;D^ ; .I $L($P(OCXDT," ",2)) S OCXDT=OCXMON_" "_$P($P(OCXDT," ",1),"/",2)_"@"_$TR($P(OCXDT," ",2),":","")
84 ;;R^"860.8:",100,19
85 ;;D^ ; .E S OCXDT=OCXMON_" "_$P($P(OCXDT," ",1),"/",2)
86 ;;R^"860.8:",100,20
87 ;;D^ ; ;
88 ;;R^"860.8:",100,21
89 ;;D^ ; I $L(OCXDT),(OCXDT?1.2N1"/"1.2N1"/"1.2N.1" ".2N.1":".2N) D ; EXTERNAL EXPERT SYSTEM FORMAT 3 TO EXTERNAL FORMAT
90 ;;R^"860.8:",100,22
91 ;;D^ ; .N OCXMON
92 ;;R^"860.8:",100,23
93 ;;D^ ; .S OCXMON=$P("January^February^March^April^May^June^July^August^September^October^November^December",U,$P(OCXDT,"/",1))
94 ;;R^"860.8:",100,24
95 ;;D^ ; .I $L($P(OCXDT," ",2)) S OCXDT=OCXMON_" "_$P($P(OCXDT," ",1),"/",2)_","_$P($P(OCXDT," ",1),"/",3)_"@"_$TR($P(OCXDT," ",2),":","")
96 ;;R^"860.8:",100,25
97 ;;D^ ; .E S OCXDT=OCXMON_" "_$P($P(OCXDT," ",1),"/",2)_", "_$P($P(OCXDT," ",1),"/",3)
98 ;;R^"860.8:",100,26
99 ;;D^ ; ;
100 ;;R^"860.8:",100,27
101 ;;D^ ; I $L(OCXDT),'OCXDT D ; EXTERNAL FORMAT TO INTERNAL FILEMAN FORMAT
102 ;;R^"860.8:",100,28
103 ;;D^ ; .I (OCXDT["@0000") S OCXDT=$P(OCXDT,"@",1),OCXDIFF=1
104 ;;R^"860.8:",100,29
105 ;;D^ ; .N %DT,X,Y S X=OCXDT,%DT="" S:(OCXDT["@")!(OCXDT="N") %DT="T" D ^%DT S OCXDT=+Y
106 ;;R^"860.8:",100,30
107 ;;D^ ; ;
108 ;;R^"860.8:",100,31
109 ;;D^ ; I ($L(OCXDT\1)>7) S OCXDT=$$HL7TFM^XLFDT(OCXDT) ; HL7 FORMAT TO INTERNAL FILEMAN FORMAT
110 ;;R^"860.8:",100,32
111 ;;D^ ; ;
112 ;;R^"860.8:",100,33
113 ;;D^ ; I ($L(OCXDT\1)=7) S OCXDT=$$FMTH^XLFDT(+OCXDT) ; INTERNAL FILEMAN FORMAT TO $H FORMAT
114 ;;R^"860.8:",100,34
115 ;;D^ ; ;
116 ;;R^"860.8:",100,35
117 ;;D^ ; I (OCXDT?5N1","1.5N) S OCXVAL=(OCXDT*86400)+$P(OCXDT,",",2) ; $H FORMAT TO EXPERT SYSTEM INTERNAL FORMAT
118 ;;R^"860.8:",100,36
119 ;;D^ ; ;
120 ;;R^"860.8:",100,37
121 ;;D^ ; Q OCXVAL
122 ;;R^"860.8:",100,38
123 ;;D^ ; ;
124 ;;EOR^
125 ;;KEY^860.8:^CONVERT DATE FROM OCX FORMAT TO READABLE FORMAT
126 ;;R^"860.8:",.01,"E"
127 ;;D^CONVERT DATE FROM OCX FORMAT TO READABLE FORMAT
128 ;;R^"860.8:",.02,"E"
129 ;;D^INT2DT
130 ;;R^"860.8:",1,1
131 ;;D^ ;INT2DT(OCXDT,OCXF) ; This Local Extrinsic Function converts an OCX internal format
132 ;;R^"860.8:",1,2
133 ;;D^ ; ; date into an Externl Format (Human Readable) date. 'OCXF=SHORT FORMAT OCXF=LONG FORMAT
134 ;;R^"860.8:",1,3
135 ;;D^ ; ;
136 ;;R^"860.8:",100,1
137 ;;D^ ;INT2DT(OCXDT,OCXF) ; This Local Extrinsic Function converts an OCX internal format
138 ;;R^"860.8:",100,2
139 ;;D^ ; ; date into an Externl Format (Human Readable) date. 'OCXF=SHORT FORMAT OCXF=LONG FORMAT
140 ;;R^"860.8:",100,3
141 ;;D^ ; ;
142 ;;R^"860.8:",100,4
143 ;;D^ ; Q:'$L($G(OCXDT)) "" S OCXF=+$G(OCXF)
144 ;;R^"860.8:",100,5
145 ;;D^ ; N OCXYR,OCXLPYR,OCXMON,OCXDAY,OCXHR,OCXMIN,OCXSEC,OCXCYR
146 ;;R^"860.8:",100,6
147 ;;D^ ; S (OCXYR,OCXLPYR,OCXMON,OCXDAY,OCXHR,OCXMIN,OCXSEC,OCXAP)=""
148 ;;R^"860.8:",100,7
149 ;;D^ ; S OCXSEC=$E(OCXDT#60+100,2,3),OCXDT=OCXDT\60
150 ;;R^"860.8:",100,8
151 ;;D^ ; S OCXMIN=$E(OCXDT#60+100,2,3),OCXDT=OCXDT\60
152 ;;R^"860.8:",100,9
153 ;;D^ ; S OCXHR=$E(OCXDT#24+100,2,3),OCXDT=OCXDT\24
154 ;;R^"860.8:",100,10
155 ;;D^ ; S OCXCYR=($H\1461)*4+1841+(($H#1461)\365)
156 ;;R^"860.8:",100,11
157 ;;D^ ; S OCXYR=(OCXDT\1461)*4+1841,OCXDT=OCXDT#1461
158 ;;R^"860.8:",100,12
159 ;;D^ ; S OCXLPYR=(OCXDT\365),OCXDT=OCXDT-(OCXLPYR*365),OCXYR=OCXYR+OCXLPYR
160 ;;R^"860.8:",100,13
161 ;;D^ ; S OCXCNT="031^059^090^120^151^181^212^243^273^304^334^365"
162 ;;R^"860.8:",100,14
163 ;;D^ ; S:(OCXLPYR=3) OCXCNT="031^060^091^121^152^182^213^244^274^305^335^366"
164 ;;R^"860.8:",100,15
165 ;;D^ ; F OCXMON=1:1:12 Q:(OCXDT<$P(OCXCNT,U,OCXMON))
166 ;;R^"860.8:",100,16
167 ;;D^ ; S OCXDAY=OCXDT-$P(OCXCNT,U,OCXMON-1)+1
168 ;;R^"860.8:",100,17
169 ;;D^ ; I OCXF S OCXMON=$P("January^February^March^April^May^June^July^August^September^October^November^December",U,OCXMON)
170 ;;R^"860.8:",100,18
171 ;;D^ ; E S OCXMON=$E(OCXMON+100,2,3)
172 ;;R^"860.8:",100,19
173 ;;D^ ; S OCXAP=$S('OCXHR:"Midnight",(OCXHR=12):"Noon",(OCXHR<12):"AM",1:"PM")
174 ;;R^"860.8:",100,20
175 ;;D^ ; I OCXF S OCXHR=OCXHR#12 S:'OCXHR OCXHR=12
176 ;;R^"860.8:",100,21
177 ;;D^ ; Q:'OCXF $E(OCXMON+100,2,3)_"/"_$E(OCXDAY+100,2,3)_$S((OCXCYR=OCXYR):" "_OCXHR_":"_OCXMIN,1:"/"_$E(OCXYR,3,4))
178 ;;R^"860.8:",100,22
179 ;;D^ ; Q:(OCXHR+OCXMIN+OCXSEC) OCXMON_" "_OCXDAY_","_OCXYR_" at "_OCXHR_":"_OCXMIN_"."_OCXSEC_" "_OCXAP
180 ;1;
181 ;
Note: See TracBrowser for help on using the repository browser.