- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXOZ01.m
r613 r623 1 OCXOZ01 ;SLC/RJS,CLA - Order Check Scan ;NOV 8,2009 at 18:442 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,221,243**;Dec 17,1997;Build 242 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 ; Compiled by: DEWAYNE,ROBERT (DUZ=9)20 21 22 LOG() 23 24 25 26 27 CDATA() 28 29 30 31 32 UPDATE(DFN,OCXSRC,OUTMSG) 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 GETDF 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 SWAPOUT(NAME,ARRAY) 104 105 106 107 108 109 110 111 112 113 114 115 SWAPIN(NAME,ARRAY) 116 117 118 119 120 121 122 123 124 125 126 SCAN 127 128 129 130 131 132 133 134 135 136 137 138 139 140 TERM(OCXTERM,OCXLIST) 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 DT2INT(OCXDT) 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 1 OCXOZ01 ;SLC/RJS,CLA - Order Check Scan ;DEC 27,2007 at 06:00 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: ORMSBY,SKIP (DUZ=1) 20 Q 21 ; 22 LOG() ; 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 ; 27 CDATA() ; 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 ; 32 UPDATE(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 ; 59 GETDF ;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 ; 103 SWAPOUT(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 ; 115 SWAPIN(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 ; 126 SCAN ; 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 ; 140 TERM(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 ; 161 DT2INT(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 TracChangeset
for help on using the changeset viewer.
