source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORY24305.m@ 1450

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

initial load of WorldVistAEHR
File size: 7.1 KB
RevLine 
[613]1ORY24305 ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Install of OR*3*243) ;NOV 2,2006 at 12:05
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17,1997;Build 242
3 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
4 ;
5S ;
6 ;
7 D DOT^ORY243ES
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 ^ORY24306
15 ;
16 Q
17 ;
18DATA ;
19 ;
20 ;;R^"860.8:",100,24
21 ;;D^ ; .I $L($P(OCXDT," ",2)) S OCXDT=OCXMON_" "_$P($P(OCXDT," ",1),"/",2)_","_$P($P(OCXDT," ",1),"/",3)_"@"_$TR($P(OCXDT," ",2),":","")
22 ;;R^"860.8:",100,25
23 ;;D^ ; .E S OCXDT=OCXMON_" "_$P($P(OCXDT," ",1),"/",2)_", "_$P($P(OCXDT," ",1),"/",3)
24 ;;R^"860.8:",100,26
25 ;;D^ ; ;
26 ;;R^"860.8:",100,27
27 ;;D^ ; I $L(OCXDT),'OCXDT D ; EXTERNAL FORMAT TO INTERNAL FILEMAN FORMAT
28 ;;R^"860.8:",100,28
29 ;;D^ ; .I (OCXDT["@0000") S OCXDT=$P(OCXDT,"@",1),OCXDIFF=1
30 ;;R^"860.8:",100,29
31 ;;D^ ; .N %DT,X,Y S X=OCXDT,%DT="" S:(OCXDT["@")!(OCXDT="N") %DT="T" D ^%DT S OCXDT=+Y
32 ;;R^"860.8:",100,30
33 ;;D^ ; ;
34 ;;R^"860.8:",100,31
35 ;;D^ ; I ($L(OCXDT\1)>7) S OCXDT=$$HL7TFM^XLFDT(OCXDT) ; HL7 FORMAT TO INTERNAL FILEMAN FORMAT
36 ;;R^"860.8:",100,32
37 ;;D^ ; ;
38 ;;R^"860.8:",100,33
39 ;;D^ ; I ($L(OCXDT\1)=7) S OCXDT=$$FMTH^XLFDT(+OCXDT) ; INTERNAL FILEMAN FORMAT TO $H FORMAT
40 ;;R^"860.8:",100,34
41 ;;D^ ; ;
42 ;;R^"860.8:",100,35
43 ;;D^ ; I (OCXDT?5N1","1.5N) S OCXVAL=(OCXDT*86400)+$P(OCXDT,",",2) ; $H FORMAT TO EXPERT SYSTEM INTERNAL FORMAT
44 ;;R^"860.8:",100,36
45 ;;D^ ; ;
46 ;;R^"860.8:",100,37
47 ;;D^ ; Q OCXVAL
48 ;;R^"860.8:",100,38
49 ;;D^ ; ;
50 ;;EOR^
51 ;;KEY^860.8:^CONVERT DATE FROM OCX FORMAT TO READABLE FORMAT
52 ;;R^"860.8:",.01,"E"
53 ;;D^CONVERT DATE FROM OCX FORMAT TO READABLE FORMAT
54 ;;R^"860.8:",.02,"E"
55 ;;D^INT2DT
56 ;;R^"860.8:",1,1
57 ;;D^ ;INT2DT(OCXDT,OCXF) ; This Local Extrinsic Function converts an OCX internal format
58 ;;R^"860.8:",1,2
59 ;;D^ ; ; date into an Externl Format (Human Readable) date. 'OCXF=SHORT FORMAT OCXF=LONG FORMAT
60 ;;R^"860.8:",1,3
61 ;;D^ ; ;
62 ;;R^"860.8:",100,1
63 ;;D^ ;INT2DT(OCXDT,OCXF) ; This Local Extrinsic Function converts an OCX internal format
64 ;;R^"860.8:",100,2
65 ;;D^ ; ; date into an Externl Format (Human Readable) date. 'OCXF=SHORT FORMAT OCXF=LONG FORMAT
66 ;;R^"860.8:",100,3
67 ;;D^ ; ;
68 ;;R^"860.8:",100,4
69 ;;D^ ; Q:'$L($G(OCXDT)) "" S OCXF=+$G(OCXF)
70 ;;R^"860.8:",100,5
71 ;;D^ ; N OCXYR,OCXLPYR,OCXMON,OCXDAY,OCXHR,OCXMIN,OCXSEC,OCXCYR
72 ;;R^"860.8:",100,6
73 ;;D^ ; S (OCXYR,OCXLPYR,OCXMON,OCXDAY,OCXHR,OCXMIN,OCXSEC,OCXAP)=""
74 ;;R^"860.8:",100,7
75 ;;D^ ; S OCXSEC=$E(OCXDT#60+100,2,3),OCXDT=OCXDT\60
76 ;;R^"860.8:",100,8
77 ;;D^ ; S OCXMIN=$E(OCXDT#60+100,2,3),OCXDT=OCXDT\60
78 ;;R^"860.8:",100,9
79 ;;D^ ; S OCXHR=$E(OCXDT#24+100,2,3),OCXDT=OCXDT\24
80 ;;R^"860.8:",100,10
81 ;;D^ ; S OCXCYR=($H\1461)*4+1841+(($H#1461)\365)
82 ;;R^"860.8:",100,11
83 ;;D^ ; S OCXYR=(OCXDT\1461)*4+1841,OCXDT=OCXDT#1461
84 ;;R^"860.8:",100,12
85 ;;D^ ; S OCXLPYR=(OCXDT\365),OCXDT=OCXDT-(OCXLPYR*365),OCXYR=OCXYR+OCXLPYR
86 ;;R^"860.8:",100,13
87 ;;D^ ; S OCXCNT="031^059^090^120^151^181^212^243^273^304^334^365"
88 ;;R^"860.8:",100,14
89 ;;D^ ; S:(OCXLPYR=3) OCXCNT="031^060^091^121^152^182^213^244^274^305^335^366"
90 ;;R^"860.8:",100,15
91 ;;D^ ; F OCXMON=1:1:12 Q:(OCXDT<$P(OCXCNT,U,OCXMON))
92 ;;R^"860.8:",100,16
93 ;;D^ ; S OCXDAY=OCXDT-$P(OCXCNT,U,OCXMON-1)+1
94 ;;R^"860.8:",100,17
95 ;;D^ ; I OCXF S OCXMON=$P("January^February^March^April^May^June^July^August^September^October^November^December",U,OCXMON)
96 ;;R^"860.8:",100,18
97 ;;D^ ; E S OCXMON=$E(OCXMON+100,2,3)
98 ;;R^"860.8:",100,19
99 ;;D^ ; S OCXAP=$S('OCXHR:"Midnight",(OCXHR=12):"Noon",(OCXHR<12):"AM",1:"PM")
100 ;;R^"860.8:",100,20
101 ;;D^ ; I OCXF S OCXHR=OCXHR#12 S:'OCXHR OCXHR=12
102 ;;R^"860.8:",100,21
103 ;;D^ ; Q:'OCXF $E(OCXMON+100,2,3)_"/"_$E(OCXDAY+100,2,3)_$S((OCXCYR=OCXYR):" "_OCXHR_":"_OCXMIN,1:"/"_$E(OCXYR,3,4))
104 ;;R^"860.8:",100,22
105 ;;D^ ; Q:(OCXHR+OCXMIN+OCXSEC) OCXMON_" "_OCXDAY_","_OCXYR_" at "_OCXHR_":"_OCXMIN_"."_OCXSEC_" "_OCXAP
106 ;;R^"860.8:",100,23
107 ;;D^ ; Q OCXMON_" "_OCXDAY_","_OCXYR
108 ;;R^"860.8:",100,24
109 ;;D^ ; ;
110 ;;EOR^
111 ;;KEY^860.8:^ELAPSED ORDER CHECK TIME LOGGER
112 ;;R^"860.8:",.01,"E"
113 ;;D^ELAPSED ORDER CHECK TIME LOGGER
114 ;;R^"860.8:",.02,"E"
115 ;;D^TIMELOG
116 ;;R^"860.8:",100,1
117 ;;D^ ;TIMELOG(OCXMODE,OCXCALL) ; Log an entry in the Elapsed time log.
118 ;;R^"860.8:",100,2
119 ;;D^ ; ;
120 ;;R^"860.8:",100,3
121 ;;D^ ; ;
122 ;;R^"860.8:",100,4
123 ;;D^ ; Q 0
124 ;;R^"860.8:",100,5
125 ;;D^ ; ;
126 ;;EOR^
127 ;;KEY^860.8:^EQUALS TERM OPERATOR
128 ;;R^"860.8:",.01,"E"
129 ;;D^EQUALS TERM OPERATOR
130 ;;R^"860.8:",.02,"E"
131 ;;D^EQTERM
132 ;;R^"860.8:",100,1
133 ;;D^ ;EQTERM(DATA,TERM) ;
134 ;;R^"860.8:",100,2
135 ;;D^ ; ;
136 ;;R^"860.8:",100,3
137 ;;D^T+; I $G(OCXTRACE) W !,"%%%%",?20," Execution trace DATA: ",$G(DATA)," TERM: ",$G(TERM)
138 ;;R^"860.8:",100,4
139 ;;D^ ; N OCXF,OCXL
140 ;;R^"860.8:",100,5
141 ;;D^ ; ;
142 ;;R^"860.8:",100,6
143 ;;D^ ; S OCXL="",OCXF=$$TERMLKUP(TERM,.OCXL)
144 ;;R^"860.8:",100,7
145 ;;D^T-; Q:'OCXF 0
146 ;;R^"860.8:",100,8
147 ;;D^T+; I 'OCXF W:$G(OCXTRACE) !,"%%%%",?20," Term '",TERM,"' not in Order Check National Term File" Q 0
148 ;;R^"860.8:",100,9
149 ;;D^T+; I '$O(OCXL(0)) W:$G(OCXTRACE) !,"%%%%",?20," There are no local terms listed for the National Term '",TERM,"'." Q 0
150 ;;R^"860.8:",100,10
151 ;;D^T+; I ($D(OCXL(DATA))!$D(OCXL("B",DATA))) W:$G(OCXTRACE) !,"%%%%",?20," Data equals Term" Q 1
152 ;;R^"860.8:",100,11
153 ;;D^T-; I ($D(OCXL(DATA))!$D(OCXL("B",DATA))) Q 1
154 ;;R^"860.8:",100,12
155 ;;D^T-; Q 0
156 ;;R^"860.8:",100,13
157 ;;D^T+; W:$G(OCXTRACE) !,"%%%%",?20," Data does not equal Term" Q 0
158 ;;R^"860.8:",100,14
159 ;;D^ ; ;
160 ;;EOR^
161 ;;KEY^860.8:^FILE DATA IN PATIENT ACTIVE DATA FILE
162 ;;R^"860.8:",.01,"E"
163 ;;D^FILE DATA IN PATIENT ACTIVE DATA FILE
164 ;;R^"860.8:",.02,"E"
165 ;;D^FILE
166 ;;R^"860.8:",1,1
167 ;;D^ ;FILE(DFN,OCXELE,OCXDFL) ; This Local Extrinsic Function files data
168 ;;R^"860.8:",1,2
169 ;;D^ ; ; in the Order Check Patient Data File
170 ;;R^"860.8:",1,3
171 ;;D^ ; ;
172 ;;R^"860.8:",100,1
173 ;;D^ ;FILE(DFN,OCXELE,OCXDFL) ; This Local Extrinsic Function logs a validated event/element.
174 ;;R^"860.8:",100,2
175 ;;D^ ; ;
176 ;;R^"860.8:",100,3
177 ;;D^T+; I $G(OCXTRACE) W !,"%%%%",?20," Execution trace DFN: ",DFN," OCXELE: ",+$G(OCXELE)," OCXDFL: ",$G(OCXDFL)
178 ;;R^"860.8:",100,4
179 ;;D^ ; N OCXTIMN,OCXTIML,OCXTIMT1,OCXTIMT2,OCXDATA,OCXPC,OCXPC,OCXVAL,OCXSUB,OCXDFI
180 ;;R^"860.8:",100,5
181 ;;D^ ; S DFN=+$G(DFN),OCXELE=+$G(OCXELE)
182 ;;R^"860.8:",100,6
183 ;;D^ ; ;
184 ;;R^"860.8:",100,7
185 ;;D^ ; Q:'DFN 1 Q:'OCXELE 1 K OCXDATA
186 ;;R^"860.8:",100,8
187 ;;D^ ; ;
188 ;;R^"860.8:",100,9
189 ;;D^ ; S OCXDATA(DFN,OCXELE)=1
190 ;;R^"860.8:",100,10
191 ;;D^ ; F OCXPC=1:1:$L(OCXDFL,",") S OCXDFI=$P(OCXDFL,",",OCXPC) I OCXDFI D
192 ;;R^"860.8:",100,11
193 ;;D^ ; .S OCXVAL=$G(OCXDF(+OCXDFI)),OCXDATA(DFN,OCXELE,+OCXDFI)=OCXVAL
194 ;;R^"860.8:",100,12
195 ;;D^T+; .I $G(OCXTRACE) W !,"%%%%",?20," ",$P($G(^OCXS(860.4,+OCXDFI,0)),U,1)," = """,OCXVAL,""""
196 ;;R^"860.8:",100,13
197 ;;D^ ; ;
198 ;;R^"860.8:",100,14
199 ;;D^ ; M ^TMP("OCXCHK",$J,DFN)=OCXDATA(DFN)
200 ;;R^"860.8:",100,15
201 ;;D^ ; ;
202 ;;R^"860.8:",100,16
203 ;;D^ ; Q 0
204 ;;R^"860.8:",100,17
205 ;;D^ ; ;
206 ;;EOR^
207 ;;KEY^860.8:^GENERATE STRING CHECKSUM
208 ;;R^"860.8:",.01,"E"
209 ;;D^GENERATE STRING CHECKSUM
210 ;;R^"860.8:",.02,"E"
211 ;;D^CKSUM
212 ;1;
213 ;
Note: See TracBrowser for help on using the repository browser.