source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXOZ01.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.2 KB
Line 
1OCXOZ01 ;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 ; compiled code line length: 200
12 ; compiled routine size: 8000
13 ; triggered rule ignore period: 300
14 ;
15 ; Program Execution Trace Mode: OFF
16 ;
17 ; Raw Data Logging: OFF
18 ; Compiler mode: ON
19 ; Compiled by: HARVEY,JULIE S (DUZ=1)
20 Q
21 ;
22LOG() ; Returns the number of days to keep the Raw Data Log or 0 if logging is disabled.
23 ; External Call.
24 ;
25 Q 0
26 ;
27CDATA() ; Returns compiler flags, Execution TRACE ON/OFF, Time Logging ON/OFF, and Raw Data Logging ON/OFF
28 ; External Call.
29 ;
30 Q "0^0^0"
31 ;
32UPDATE(DFN,OCXSRC,OUTMSG) ; Main Entry point for evaluating Rules.
33 ; External Call.
34 ;
35 ;
36 K ^TMP("OCXCHK",$J)
37 S ^TMP("OCXCHK",$J)=($P($H,",",2)+($H*86400)+(2*60))_" <- ^TMP ENTRY EXPIRATION DATE FOR ^OCXOPURG"
38 N OCXOERR,OCXOCMSG,OCXNDX,OCXDF,OCXX,OCXTSPI
39 S OCXTSPI=300
40 Q:'$G(DFN)
41 I ($G(OCXOSRC)="GENERIC HL7 MESSAGE ARRAY") D GETDF,SWAPOUT("OCXODATA",.OCXODATA)
42 I ($G(OCXOSRC)="GENERIC HL7 MESSAGE ARRAY") D CHK1^OCXOZ02
43 I ($G(OCXOSRC)="DGPM PATIENT MOVEMENT PROTOCOL") D CHK23^OCXOZ03
44 I ($G(OCXOSRC)="CPRS ORDER PRESCAN") D CHK58^OCXOZ05
45 I ($G(OCXOSRC)="CPRS ORDER PROTOCOL") D CHK95^OCXOZ06
46 ;
47 D SCAN
48 ;
49 I $O(OCXOCMSG("")) D
50 .N OCXNDX1,OCXNDX2
51 .S OCXNDX1=0 F S OCXNDX1=$O(OCXOCMSG(OCXNDX1)) Q:'OCXNDX1 D
52 ..S OCXNDX2=0 F S OCXNDX2=$O(OUTMSG(OCXNDX2)) Q:'OCXNDX2 Q:(OUTMSG(OCXNDX2)=OCXOCMSG(OCXNDX1))
53 ..Q:OCXNDX2 S OUTMSG($O(OUTMSG(999999),-1)+1)=OCXOCMSG(OCXNDX1)
54 K ^TMP("OCXCHK",$J)
55 ;
56 I ($G(OCXOSRC)="GENERIC HL7 MESSAGE ARRAY") K OCXDF D SWAPIN("OCXODATA",.OCXODATA)
57 Q
58 ;
59GETDF ;This subroutine loads the OCXDF data field array from variables in the environment.
60 ; Called from UPDATE+9.
61 ;
62 Q:$G(OCXOERR)
63 ;
64 ; Local GETDF Variables
65 ; OCXDF(1) ----> Data Field: CONTROL CODE (FREE TEXT)
66 ; OCXDF(2) ----> Data Field: FILLER (FREE TEXT)
67 ; OCXDF(5) ----> Data Field: ORDER PRIORITY (OBR) (FREE TEXT)
68 ; OCXDF(6) ----> Data Field: ABNORMAL FLAG (FREE TEXT)
69 ; OCXDF(9) ----> Data Field: ORDER ST D/T (DATE/TIME)
70 ; OCXDF(12) ---> Data Field: LAB RESULT (FREE TEXT)
71 ; OCXDF(13) ---> Data Field: LAB COLLECTION D/T (DATE/TIME)
72 ; OCXDF(15) ---> Data Field: RESULT STATUS (OBX) (FREE TEXT)
73 ; OCXDF(21) ---> Data Field: ORDER PRIORITY (ORC) (FREE TEXT)
74 ; OCXDF(23) ---> Data Field: REQUEST STATUS (OBR) (FREE TEXT)
75 ; OCXDF(24) ---> Data Field: ORDERABLE ITEM LOCAL TEXT (FREE TEXT)
76 ; OCXDF(34) ---> Data Field: ORDER NUMBER (NUMERIC)
77 ; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC)
78 ; OCXDF(82) ---> Data Field: PHARMACY LOCAL ORDERABLE ITEM TEXT (FREE TEXT)
79 ; OCXDF(113) --> Data Field: LAB TEST ID (NUMERIC)
80 ; OCXDF(152) --> Data Field: LAB SPECIMEN ID (NUMERIC)
81 ;
82 ; Local Extrinsic Functions
83 ; DT2INT( ----------> CONVERT DATE FROM FILEMAN FORMAT TO OCX FORMAT
84 ;
85 S OCXDF(1)=$P($G(OCXODATA("ORC",1)),"^",1)
86 S OCXDF(2)=$P($G(OCXODATA("ORC",3)),"^",2)
87 S OCXDF(5)=$P($P($G(OCXODATA("OBR",27)),"^",6),";",1)
88 S OCXDF(6)=$P($G(OCXODATA("OBX",8)),"^",1)
89 S OCXDF(9)=$$DT2INT($P($G(OCXODATA("ORC",15)),"^",1))
90 S OCXDF(12)=$P($G(OCXODATA("OBX",5)),"^",1)
91 S OCXDF(13)=$$DT2INT($P($G(OCXODATA("OBR",7)),"^",1))
92 S OCXDF(15)=$P($G(OCXODATA("OBX",11)),"^",1)
93 S OCXDF(21)=$P($G(OCXODATA("ORC",7)),"^",6)
94 S OCXDF(23)=$P($G(OCXODATA("OBR",25)),"^",1)
95 S OCXDF(24)=$P($G(OCXODATA("OBR",4)),"^",5)
96 S OCXDF(34)=$P($G(OCXODATA("ORC",2)),"^",1)
97 S OCXDF(37)=$G(OCXODATA("PID",3))
98 S OCXDF(82)=$P($G(OCXODATA("RXO",1)),"^",5)
99 S OCXDF(113)=$P($G(OCXODATA("OBX",3)),"^",4)
100 S OCXDF(152)=$P($P($G(OCXODATA("OBR",15)),"^",4),";",1)
101 Q
102 ;
103SWAPOUT(NAME,ARRAY) ;
104 ; Called from UPDATE+9.
105 ;
106 Q:$G(OCXOERR)
107 ;
108 Q:'$L(NAME)
109 K ^TMP("OCXSWAP",$J,NAME)
110 S ^TMP("OCXSWAP",$J)=($P($H,",",2)+($H*86400)+(2*60))_" <- ^TMP ENTRY EXPIRATION DATE FOR ^OCXOPURG"
111 M ^TMP("OCXSWAP",$J,NAME)=ARRAY
112 K ARRAY
113 Q
114 ;
115SWAPIN(NAME,ARRAY) ;
116 ; Called from UPDATE+24.
117 ;
118 Q:$G(OCXOERR)
119 ;
120 Q:'$L(NAME)
121 K ARRAY
122 M ARRAY=^TMP("OCXSWAP",$J,NAME)
123 K ^TMP("OCXSWAP",$J,NAME)
124 Q
125 ;
126SCAN ; Tests all Rules for Event/Elements that were found to be valid in the UPDATE subroutine.
127 ; Called from UPDATE+15.
128 ;
129 Q:$G(OCXOERR)
130 ;
131 ;
132 N OCXD0,OCXRULE S OCXD0=0 F S OCXD0=$O(^TMP("OCXCHK",$J,DFN,OCXD0)) Q:'OCXD0 D
133 .Q:'($G(^TMP("OCXCHK",$J,DFN,OCXD0))=1)
134 .N OCXPGM S OCXPGM=$O(^OCXS(860.3,"APGM",OCXD0,"")) Q:'$L(OCXPGM) X "I $L($T("_OCXPGM_"))" E Q
135 .D @OCXPGM
136 .S ^TMP("OCXCHK",$J,DFN,OCXD0)=$G(^TMP("OCXCHK",$J,DFN,OCXD0))+10
137 K ^TMP("OCXCHK",$J)
138 Q
139 ;
140TERM(OCXTERM,OCXLIST) ; Local Term Lookup
141 ; Internal Call.
142 ;
143 Q:$G(OCXOERR)
144 ;
145 Q:'$L(OCXTERM) 0
146 ;
147 N FILE,IEN,LINE,LTERM,NTERM,TEXT S FILE=0 K OCXLIST
148 F LINE=1:1:999 S TEXT=$T(TERM+LINE) Q:$P(TEXT,";",2) I ($E(TEXT,2,3)=";;") D
149 .S TEXT=$P(TEXT,";;",2)
150 .S NTERM=$P(TEXT,U,1) Q:'$L(NTERM) Q:'(OCXTERM=NTERM)
151 .S FILE=$P(TEXT,U,2),IEN=$P(TEXT,U,3),LTERM=$P(TEXT,U,4)
152 .S OCXLIST(IEN)=LTERM,OCXLIST("B",LTERM,IEN)=""
153 ;
154 Q FILE
155 ;
156 ;TERM DATA;
157 ;1;
158 ;
159 Q
160 ;
161DT2INT(OCXDT) ; This Local Extrinsic Function converts a date into an integer
162 ; By taking the Years, Months, Days, Hours and Minutes converting
163 ; Them into Seconds and then adding them all together into one big integer
164 ;
165 Q:'$L($G(OCXDT)) ""
166 N OCXDIFF,OCXVAL S (OCXDIFF,OCXVAL)=0
167 ;
168 I $L(OCXDT),'OCXDT,(OCXDT[" at ") D ; EXTERNAL EXPERT SYSTEM FORMAT 1 TO EXTERNAL FORMAT
169 .N OCXHR,OCXMIN,OCXTIME
170 .S OCXTIME=$P($P(OCXDT," at ",2),".",1),OCXHR=$P(OCXTIME,":",1),OCXMIN=$P(OCXTIME,":",2)
171 .S:(OCXDT["Midnight") OCXHR=00
172 .S:(OCXDT["PM") OCXHR=OCXHR+12
173 .S OCXDT=$P(OCXDT," at ")_"@"_$E(OCXHR+100,2,3)_$E(OCXMIN+100,2,3)
174 ;
175 I $L(OCXDT),(OCXDT?1.2N1"/"1.2N.1" ".2N.1":".2N) D ; EXTERNAL EXPERT SYSTEM FORMAT 2 TO EXTERNAL FORMAT
176 .N OCXMON
177 .S OCXMON=$P("January^February^March^April^May^June^July^August^September^October^November^December",U,$P(OCXDT,"/",1))
178 .I $L($P(OCXDT," ",2)) S OCXDT=OCXMON_" "_$P($P(OCXDT," ",1),"/",2)_"@"_$TR($P(OCXDT," ",2),":","")
179 .E S OCXDT=OCXMON_" "_$P($P(OCXDT," ",1),"/",2)
180 ;
181 I $L(OCXDT),(OCXDT?1.2N1"/"1.2N1"/"1.2N.1" ".2N.1":".2N) D ; EXTERNAL EXPERT SYSTEM FORMAT 3 TO EXTERNAL FORMAT
182 .N OCXMON
183 .S OCXMON=$P("January^February^March^April^May^June^July^August^September^October^November^December",U,$P(OCXDT,"/",1))
184 .I $L($P(OCXDT," ",2)) S OCXDT=OCXMON_" "_$P($P(OCXDT," ",1),"/",2)_","_$P($P(OCXDT," ",1),"/",3)_"@"_$TR($P(OCXDT," ",2),":","")
185 .E S OCXDT=OCXMON_" "_$P($P(OCXDT," ",1),"/",2)_", "_$P($P(OCXDT," ",1),"/",3)
186 ;
187 I $L(OCXDT),'OCXDT D ; EXTERNAL FORMAT TO INTERNAL FILEMAN FORMAT
188 .I (OCXDT["@0000") S OCXDT=$P(OCXDT,"@",1),OCXDIFF=1
189 .N %DT,X,Y S X=OCXDT,%DT="" S:(OCXDT["@")!(OCXDT="N") %DT="T" D ^%DT S OCXDT=+Y
190 ;
191 I ($L(OCXDT\1)>7) S OCXDT=$$HL7TFM^XLFDT(OCXDT) ; HL7 FORMAT TO INTERNAL FILEMAN FORMAT
192 ;
193 I ($L(OCXDT\1)=7) S OCXDT=$$FMTH^XLFDT(+OCXDT) ; INTERNAL FILEMAN FORMAT TO $H FORMAT
194 ;
195 I (OCXDT?5N1","1.5N) S OCXVAL=(OCXDT*86400)+$P(OCXDT,",",2) ; $H FORMAT TO EXPERT SYSTEM INTERNAL FORMAT
196 ;
197 Q OCXVAL
198 ;
Note: See TracBrowser for help on using the repository browser.