OCXOZ01 ;SLC/RJS,CLA - Order Check Scan ;JAN 28,2014 at 03:37
;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,221,243**;Dec 17,1997;Build 242
;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
;
; ***************************************************************
; ** Warning: This routine is automatically generated by the **
; ** Rule Compiler (^OCXOCMP) and ANY changes to this routine **
; ** will be lost the next time the rule compiler executes. **
; ***************************************************************
;
; compiled code line length: 200
; compiled routine size: 8000
; triggered rule ignore period: 300
;
; Program Execution Trace Mode: OFF
;
; Raw Data Logging: OFF
; Compiler mode: ON
; Compiled by: ADAM,ADAM (DUZ=1)
Q
;
LOG() ; Returns the number of days to keep the Raw Data Log or 0 if logging is disabled.
; External Call.
;
Q 0
;
CDATA() ; Returns compiler flags, Execution TRACE ON/OFF, Time Logging ON/OFF, and Raw Data Logging ON/OFF
; External Call.
;
Q "0^0^0"
;
UPDATE(DFN,OCXSRC,OUTMSG) ; Main Entry point for evaluating Rules.
; External Call.
;
;
K ^TMP("OCXCHK",$J)
S ^TMP("OCXCHK",$J)=($P($H,",",2)+($H*86400)+(2*60))_" <- ^TMP ENTRY EXPIRATION DATE FOR ^OCXOPURG"
N OCXOERR,OCXOCMSG,OCXNDX,OCXDF,OCXX,OCXTSPI
S OCXTSPI=300
Q:'$G(DFN)
I ($G(OCXOSRC)="GENERIC HL7 MESSAGE ARRAY") D GETDF,SWAPOUT("OCXODATA",.OCXODATA)
I ($G(OCXOSRC)="GENERIC HL7 MESSAGE ARRAY") D CHK1^OCXOZ02
I ($G(OCXOSRC)="DGPM PATIENT MOVEMENT PROTOCOL") D CHK23^OCXOZ03
I ($G(OCXOSRC)="CPRS ORDER PRESCAN") D CHK58^OCXOZ05
I ($G(OCXOSRC)="CPRS ORDER PROTOCOL") D CHK95^OCXOZ06
;
D SCAN
;
I $O(OCXOCMSG("")) D
.N OCXNDX1,OCXNDX2
.S OCXNDX1=0 F S OCXNDX1=$O(OCXOCMSG(OCXNDX1)) Q:'OCXNDX1 D
..S OCXNDX2=0 F S OCXNDX2=$O(OUTMSG(OCXNDX2)) Q:'OCXNDX2 Q:(OUTMSG(OCXNDX2)=OCXOCMSG(OCXNDX1))
..Q:OCXNDX2 S OUTMSG($O(OUTMSG(999999),-1)+1)=OCXOCMSG(OCXNDX1)
K ^TMP("OCXCHK",$J)
;
I ($G(OCXOSRC)="GENERIC HL7 MESSAGE ARRAY") K OCXDF D SWAPIN("OCXODATA",.OCXODATA)
Q
;
GETDF ;This subroutine loads the OCXDF data field array from variables in the environment.
; Called from UPDATE+9.
;
Q:$G(OCXOERR)
;
; Local GETDF Variables
; OCXDF(1) ----> Data Field: CONTROL CODE (FREE TEXT)
; OCXDF(2) ----> Data Field: FILLER (FREE TEXT)
; OCXDF(5) ----> Data Field: ORDER PRIORITY (OBR) (FREE TEXT)
; OCXDF(6) ----> Data Field: ABNORMAL FLAG (FREE TEXT)
; OCXDF(9) ----> Data Field: ORDER ST D/T (DATE/TIME)
; OCXDF(12) ---> Data Field: LAB RESULT (FREE TEXT)
; OCXDF(13) ---> Data Field: LAB COLLECTION D/T (DATE/TIME)
; OCXDF(15) ---> Data Field: RESULT STATUS (OBX) (FREE TEXT)
; OCXDF(21) ---> Data Field: ORDER PRIORITY (ORC) (FREE TEXT)
; OCXDF(23) ---> Data Field: REQUEST STATUS (OBR) (FREE TEXT)
; OCXDF(24) ---> Data Field: ORDERABLE ITEM LOCAL TEXT (FREE TEXT)
; OCXDF(34) ---> Data Field: ORDER NUMBER (NUMERIC)
; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC)
; OCXDF(82) ---> Data Field: PHARMACY LOCAL ORDERABLE ITEM TEXT (FREE TEXT)
; OCXDF(113) --> Data Field: LAB TEST ID (NUMERIC)
; OCXDF(152) --> Data Field: LAB SPECIMEN ID (NUMERIC)
;
; Local Extrinsic Functions
; DT2INT( ----------> CONVERT DATE FROM FILEMAN FORMAT TO OCX FORMAT
;
S OCXDF(1)=$P($G(OCXODATA("ORC",1)),"^",1)
S OCXDF(2)=$P($G(OCXODATA("ORC",3)),"^",2)
S OCXDF(5)=$P($P($G(OCXODATA("OBR",27)),"^",6),";",1)
S OCXDF(6)=$P($G(OCXODATA("OBX",8)),"^",1)
S OCXDF(9)=$$DT2INT($P($G(OCXODATA("ORC",15)),"^",1))
S OCXDF(12)=$P($G(OCXODATA("OBX",5)),"^",1)
S OCXDF(13)=$$DT2INT($P($G(OCXODATA("OBR",7)),"^",1))
S OCXDF(15)=$P($G(OCXODATA("OBX",11)),"^",1)
S OCXDF(21)=$P($G(OCXODATA("ORC",7)),"^",6)
S OCXDF(23)=$P($G(OCXODATA("OBR",25)),"^",1)
S OCXDF(24)=$P($G(OCXODATA("OBR",4)),"^",5)
S OCXDF(34)=$P($G(OCXODATA("ORC",2)),"^",1)
S OCXDF(37)=$G(OCXODATA("PID",3))
S OCXDF(82)=$P($G(OCXODATA("RXO",1)),"^",5)
S OCXDF(113)=$P($G(OCXODATA("OBX",3)),"^",4)
S OCXDF(152)=$P($P($G(OCXODATA("OBR",15)),"^",4),";",1)
Q
;
SWAPOUT(NAME,ARRAY) ;
; Called from UPDATE+9.
;
Q:$G(OCXOERR)
;
Q:'$L(NAME)
K ^TMP("OCXSWAP",$J,NAME)
S ^TMP("OCXSWAP",$J)=($P($H,",",2)+($H*86400)+(2*60))_" <- ^TMP ENTRY EXPIRATION DATE FOR ^OCXOPURG"
M ^TMP("OCXSWAP",$J,NAME)=ARRAY
K ARRAY
Q
;
SWAPIN(NAME,ARRAY) ;
; Called from UPDATE+24.
;
Q:$G(OCXOERR)
;
Q:'$L(NAME)
K ARRAY
M ARRAY=^TMP("OCXSWAP",$J,NAME)
K ^TMP("OCXSWAP",$J,NAME)
Q
;
SCAN ; Tests all Rules for Event/Elements that were found to be valid in the UPDATE subroutine.
; Called from UPDATE+15.
;
Q:$G(OCXOERR)
;
;
N OCXD0,OCXRULE S OCXD0=0 F S OCXD0=$O(^TMP("OCXCHK",$J,DFN,OCXD0)) Q:'OCXD0 D
.Q:'($G(^TMP("OCXCHK",$J,DFN,OCXD0))=1)
.N OCXPGM S OCXPGM=$O(^OCXS(860.3,"APGM",OCXD0,"")) Q:'$L(OCXPGM) X "I $L($T("_OCXPGM_"))" E Q
.D @OCXPGM
.S ^TMP("OCXCHK",$J,DFN,OCXD0)=$G(^TMP("OCXCHK",$J,DFN,OCXD0))+10
K ^TMP("OCXCHK",$J)
Q
;
TERM(OCXTERM,OCXLIST) ; Local Term Lookup
; Internal Call.
;
Q:$G(OCXOERR)
;
Q:'$L(OCXTERM) 0
;
N FILE,IEN,LINE,LTERM,NTERM,TEXT S FILE=0 K OCXLIST
F LINE=1:1:999 S TEXT=$T(TERM+LINE) Q:$P(TEXT,";",2) I ($E(TEXT,2,3)=";;") D
.S TEXT=$P(TEXT,";;",2)
.S NTERM=$P(TEXT,U,1) Q:'$L(NTERM) Q:'(OCXTERM=NTERM)
.S FILE=$P(TEXT,U,2),IEN=$P(TEXT,U,3),LTERM=$P(TEXT,U,4)
.S OCXLIST(IEN)=LTERM,OCXLIST("B",LTERM,IEN)=""
;
Q FILE
;
;TERM DATA;
;1;
;
Q
;
DT2INT(OCXDT) ; This Local Extrinsic Function converts a date into an integer
; By taking the Years, Months, Days, Hours and Minutes converting
; Them into Seconds and then adding them all together into one big integer
;
Q:'$L($G(OCXDT)) ""
N OCXDIFF,OCXVAL S (OCXDIFF,OCXVAL)=0
;
I $L(OCXDT),'OCXDT,(OCXDT[" at ") D ; EXTERNAL EXPERT SYSTEM FORMAT 1 TO EXTERNAL FORMAT
.N OCXHR,OCXMIN,OCXTIME
.S OCXTIME=$P($P(OCXDT," at ",2),".",1),OCXHR=$P(OCXTIME,":",1),OCXMIN=$P(OCXTIME,":",2)
.S:(OCXDT["Midnight") OCXHR=00
.S:(OCXDT["PM") OCXHR=OCXHR+12
.S OCXDT=$P(OCXDT," at ")_"@"_$E(OCXHR+100,2,3)_$E(OCXMIN+100,2,3)
;
I $L(OCXDT),(OCXDT?1.2N1"/"1.2N.1" ".2N.1":".2N) D ; EXTERNAL EXPERT SYSTEM FORMAT 2 TO EXTERNAL FORMAT
.N OCXMON
.S OCXMON=$P("January^February^March^April^May^June^July^August^September^October^November^December",U,$P(OCXDT,"/",1))
.I $L($P(OCXDT," ",2)) S OCXDT=OCXMON_" "_$P($P(OCXDT," ",1),"/",2)_"@"_$TR($P(OCXDT," ",2),":","")
.E S OCXDT=OCXMON_" "_$P($P(OCXDT," ",1),"/",2)
;
I $L(OCXDT),(OCXDT?1.2N1"/"1.2N1"/"1.2N.1" ".2N.1":".2N) D ; EXTERNAL EXPERT SYSTEM FORMAT 3 TO EXTERNAL FORMAT
.N OCXMON
.S OCXMON=$P("January^February^March^April^May^June^July^August^September^October^November^December",U,$P(OCXDT,"/",1))
.I $L($P(OCXDT," ",2)) S OCXDT=OCXMON_" "_$P($P(OCXDT," ",1),"/",2)_","_$P($P(OCXDT," ",1),"/",3)_"@"_$TR($P(OCXDT," ",2),":","")
.E S OCXDT=OCXMON_" "_$P($P(OCXDT," ",1),"/",2)_", "_$P($P(OCXDT," ",1),"/",3)
;
I $L(OCXDT),'OCXDT D ; EXTERNAL FORMAT TO INTERNAL FILEMAN FORMAT
.I (OCXDT["@0000") S OCXDT=$P(OCXDT,"@",1),OCXDIFF=1
.N %DT,X,Y S X=OCXDT,%DT="" S:(OCXDT["@")!(OCXDT="N") %DT="T" D ^%DT S OCXDT=+Y
;
I ($L(OCXDT\1)>7) S OCXDT=$$HL7TFM^XLFDT(OCXDT) ; HL7 FORMAT TO INTERNAL FILEMAN FORMAT
;
I ($L(OCXDT\1)=7) S OCXDT=$$FMTH^XLFDT(+OCXDT) ; INTERNAL FILEMAN FORMAT TO $H FORMAT
;
I (OCXDT?5N1","1.5N) S OCXVAL=(OCXDT*86400)+$P(OCXDT,",",2) ; $H FORMAT TO EXPERT SYSTEM INTERNAL FORMAT
;
Q OCXVAL
;
OCXOZ01 ;SLC/RJS,CLA - Order Check Scan ;JAN 28,2014 at 03:37
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,221,243**;Dec 17,1997;Build 242
+2 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
+3 ;
+4 ; ***************************************************************
+5 ; ** Warning: This routine is automatically generated by the **
+6 ; ** Rule Compiler (^OCXOCMP) and ANY changes to this routine **
+7 ; ** will be lost the next time the rule compiler executes. **
+8 ; ***************************************************************
+9 ;
+10 ; compiled code line length: 200
+11 ; compiled routine size: 8000
+12 ; triggered rule ignore period: 300
+13 ;
+14 ; Program Execution Trace Mode: OFF
+15 ;
+16 ; Raw Data Logging: OFF
+17 ; Compiler mode: ON
+18 ; Compiled by: ADAM,ADAM (DUZ=1)
+19 QUIT
+20 ;
LOG() ; Returns the number of days to keep the Raw Data Log or 0 if logging is disabled.
+1 ; External Call.
+2 ;
+3 QUIT 0
+4 ;
CDATA() ; Returns compiler flags, Execution TRACE ON/OFF, Time Logging ON/OFF, and Raw Data Logging ON/OFF
+1 ; External Call.
+2 ;
+3 QUIT "0^0^0"
+4 ;
UPDATE(DFN,OCXSRC,OUTMSG) ; Main Entry point for evaluating Rules.
+1 ; External Call.
+2 ;
+3 ;
+4 KILL ^TMP("OCXCHK",$JOB)
+5 SET ^TMP("OCXCHK",$JOB)=($PIECE($HOROLOG,",",2)+($HOROLOG*86400)+(2*60))_" <- ^TMP ENTRY EXPIRATION DATE FOR ^OCXOPURG"
+6 NEW OCXOERR,OCXOCMSG,OCXNDX,OCXDF,OCXX,OCXTSPI
+7 SET OCXTSPI=300
+8 IF '$GET(DFN)
QUIT
+9 IF ($GET(OCXOSRC)="GENERIC HL7 MESSAGE ARRAY")
DO GETDF
DO SWAPOUT("OCXODATA",.OCXODATA)
+10 IF ($GET(OCXOSRC)="GENERIC HL7 MESSAGE ARRAY")
DO CHK1^OCXOZ02
+11 IF ($GET(OCXOSRC)="DGPM PATIENT MOVEMENT PROTOCOL")
DO CHK23^OCXOZ03
+12 IF ($GET(OCXOSRC)="CPRS ORDER PRESCAN")
DO CHK58^OCXOZ05
+13 IF ($GET(OCXOSRC)="CPRS ORDER PROTOCOL")
DO CHK95^OCXOZ06
+14 ;
+15 DO SCAN
+16 ;
+17 IF $ORDER(OCXOCMSG(""))
Begin DoDot:1
+18 NEW OCXNDX1,OCXNDX2
+19 SET OCXNDX1=0
FOR
SET OCXNDX1=$ORDER(OCXOCMSG(OCXNDX1))
IF 'OCXNDX1
QUIT
Begin DoDot:2
+20 SET OCXNDX2=0
FOR
SET OCXNDX2=$ORDER(OUTMSG(OCXNDX2))
IF 'OCXNDX2
QUIT
IF (OUTMSG(OCXNDX2)=OCXOCMSG(OCXNDX1))
QUIT
+21 IF OCXNDX2
QUIT
SET OUTMSG($ORDER(OUTMSG(999999),-1)+1)=OCXOCMSG(OCXNDX1)
End DoDot:2
End DoDot:1
+22 KILL ^TMP("OCXCHK",$JOB)
+23 ;
+24 IF ($GET(OCXOSRC)="GENERIC HL7 MESSAGE ARRAY")
KILL OCXDF
DO SWAPIN("OCXODATA",.OCXODATA)
+25 QUIT
+26 ;
GETDF ;This subroutine loads the OCXDF data field array from variables in the environment.
+1 ; Called from UPDATE+9.
+2 ;
+3 IF $GET(OCXOERR)
QUIT
+4 ;
+5 ; Local GETDF Variables
+6 ; OCXDF(1) ----> Data Field: CONTROL CODE (FREE TEXT)
+7 ; OCXDF(2) ----> Data Field: FILLER (FREE TEXT)
+8 ; OCXDF(5) ----> Data Field: ORDER PRIORITY (OBR) (FREE TEXT)
+9 ; OCXDF(6) ----> Data Field: ABNORMAL FLAG (FREE TEXT)
+10 ; OCXDF(9) ----> Data Field: ORDER ST D/T (DATE/TIME)
+11 ; OCXDF(12) ---> Data Field: LAB RESULT (FREE TEXT)
+12 ; OCXDF(13) ---> Data Field: LAB COLLECTION D/T (DATE/TIME)
+13 ; OCXDF(15) ---> Data Field: RESULT STATUS (OBX) (FREE TEXT)
+14 ; OCXDF(21) ---> Data Field: ORDER PRIORITY (ORC) (FREE TEXT)
+15 ; OCXDF(23) ---> Data Field: REQUEST STATUS (OBR) (FREE TEXT)
+16 ; OCXDF(24) ---> Data Field: ORDERABLE ITEM LOCAL TEXT (FREE TEXT)
+17 ; OCXDF(34) ---> Data Field: ORDER NUMBER (NUMERIC)
+18 ; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC)
+19 ; OCXDF(82) ---> Data Field: PHARMACY LOCAL ORDERABLE ITEM TEXT (FREE TEXT)
+20 ; OCXDF(113) --> Data Field: LAB TEST ID (NUMERIC)
+21 ; OCXDF(152) --> Data Field: LAB SPECIMEN ID (NUMERIC)
+22 ;
+23 ; Local Extrinsic Functions
+24 ; DT2INT( ----------> CONVERT DATE FROM FILEMAN FORMAT TO OCX FORMAT
+25 ;
+26 SET OCXDF(1)=$PIECE($GET(OCXODATA("ORC",1)),"^",1)
+27 SET OCXDF(2)=$PIECE($GET(OCXODATA("ORC",3)),"^",2)
+28 SET OCXDF(5)=$PIECE($PIECE($GET(OCXODATA("OBR",27)),"^",6),";",1)
+29 SET OCXDF(6)=$PIECE($GET(OCXODATA("OBX",8)),"^",1)
+30 SET OCXDF(9)=$$DT2INT($PIECE($GET(OCXODATA("ORC",15)),"^",1))
+31 SET OCXDF(12)=$PIECE($GET(OCXODATA("OBX",5)),"^",1)
+32 SET OCXDF(13)=$$DT2INT($PIECE($GET(OCXODATA("OBR",7)),"^",1))
+33 SET OCXDF(15)=$PIECE($GET(OCXODATA("OBX",11)),"^",1)
+34 SET OCXDF(21)=$PIECE($GET(OCXODATA("ORC",7)),"^",6)
+35 SET OCXDF(23)=$PIECE($GET(OCXODATA("OBR",25)),"^",1)
+36 SET OCXDF(24)=$PIECE($GET(OCXODATA("OBR",4)),"^",5)
+37 SET OCXDF(34)=$PIECE($GET(OCXODATA("ORC",2)),"^",1)
+38 SET OCXDF(37)=$GET(OCXODATA("PID",3))
+39 SET OCXDF(82)=$PIECE($GET(OCXODATA("RXO",1)),"^",5)
+40 SET OCXDF(113)=$PIECE($GET(OCXODATA("OBX",3)),"^",4)
+41 SET OCXDF(152)=$PIECE($PIECE($GET(OCXODATA("OBR",15)),"^",4),";",1)
+42 QUIT
+43 ;
SWAPOUT(NAME,ARRAY) ;
+1 ; Called from UPDATE+9.
+2 ;
+3 IF $GET(OCXOERR)
QUIT
+4 ;
+5 IF '$LENGTH(NAME)
QUIT
+6 KILL ^TMP("OCXSWAP",$JOB,NAME)
+7 SET ^TMP("OCXSWAP",$JOB)=($PIECE($HOROLOG,",",2)+($HOROLOG*86400)+(2*60))_" <- ^TMP ENTRY EXPIRATION DATE FOR ^OCXOPURG"
+8 MERGE ^TMP("OCXSWAP",$JOB,NAME)=ARRAY
+9 KILL ARRAY
+10 QUIT
+11 ;
SWAPIN(NAME,ARRAY) ;
+1 ; Called from UPDATE+24.
+2 ;
+3 IF $GET(OCXOERR)
QUIT
+4 ;
+5 IF '$LENGTH(NAME)
QUIT
+6 KILL ARRAY
+7 MERGE ARRAY=^TMP("OCXSWAP",$JOB,NAME)
+8 KILL ^TMP("OCXSWAP",$JOB,NAME)
+9 QUIT
+10 ;
SCAN ; Tests all Rules for Event/Elements that were found to be valid in the UPDATE subroutine.
+1 ; Called from UPDATE+15.
+2 ;
+3 IF $GET(OCXOERR)
QUIT
+4 ;
+5 ;
+6 NEW OCXD0,OCXRULE
SET OCXD0=0
FOR
SET OCXD0=$ORDER(^TMP("OCXCHK",$JOB,DFN,OCXD0))
IF 'OCXD0
QUIT
Begin DoDot:1
+7 IF '($GET(^TMP("OCXCHK",$JOB,DFN,OCXD0))=1)
QUIT
+8 NEW OCXPGM
SET OCXPGM=$ORDER(^OCXS(860.3,"APGM",OCXD0,""))
IF '$LENGTH(OCXPGM)
QUIT
XECUTE "I $L($T("_OCXPGM_"))"
IF '$TEST
QUIT
+9 DO @OCXPGM
+10 SET ^TMP("OCXCHK",$JOB,DFN,OCXD0)=$GET(^TMP("OCXCHK",$JOB,DFN,OCXD0))+10
End DoDot:1
+11 KILL ^TMP("OCXCHK",$JOB)
+12 QUIT
+13 ;
TERM(OCXTERM,OCXLIST) ; Local Term Lookup
+1 ; Internal Call.
+2 ;
+3 IF $GET(OCXOERR)
QUIT
+4 ;
+5 IF '$LENGTH(OCXTERM)
QUIT 0
+6 ;
+7 NEW FILE,IEN,LINE,LTERM,NTERM,TEXT
SET FILE=0
KILL OCXLIST
+8 FOR LINE=1:1:999
SET TEXT=$TEXT(TERM+LINE)
IF $PIECE(TEXT,";",2)
QUIT
IF ($EXTRACT(TEXT,2,3)=";;")
Begin DoDot:1
+9 SET TEXT=$PIECE(TEXT,";;",2)
+10 SET NTERM=$PIECE(TEXT,U,1)
IF '$LENGTH(NTERM)
QUIT
IF '(OCXTERM=NTERM)
QUIT
+11 SET FILE=$PIECE(TEXT,U,2)
SET IEN=$PIECE(TEXT,U,3)
SET LTERM=$PIECE(TEXT,U,4)
+12 SET OCXLIST(IEN)=LTERM
SET OCXLIST("B",LTERM,IEN)=""
End DoDot:1
+13 ;
+14 QUIT FILE
+15 ;
+16 ;TERM DATA;
+17 ;1;
+18 ;
+19 QUIT
+20 ;
DT2INT(OCXDT) ; This Local Extrinsic Function converts a date into an integer
+1 ; By taking the Years, Months, Days, Hours and Minutes converting
+2 ; Them into Seconds and then adding them all together into one big integer
+3 ;
+4 IF '$LENGTH($GET(OCXDT))
QUIT ""
+5 NEW OCXDIFF,OCXVAL
SET (OCXDIFF,OCXVAL)=0
+6 ;
+7 ; EXTERNAL EXPERT SYSTEM FORMAT 1 TO EXTERNAL FORMAT
IF $LENGTH(OCXDT)
IF 'OCXDT
IF (OCXDT[" at ")
Begin DoDot:1
+8 NEW OCXHR,OCXMIN,OCXTIME
+9 SET OCXTIME=$PIECE($PIECE(OCXDT," at ",2),".",1)
SET OCXHR=$PIECE(OCXTIME,":",1)
SET OCXMIN=$PIECE(OCXTIME,":",2)
+10 IF (OCXDT["Midnight")
SET OCXHR=00
+11 IF (OCXDT["PM")
SET OCXHR=OCXHR+12
+12 SET OCXDT=$PIECE(OCXDT," at ")_"@"_$EXTRACT(OCXHR+100,2,3)_$EXTRACT(OCXMIN+100,2,3)
End DoDot:1
+13 ;
+14 ; EXTERNAL EXPERT SYSTEM FORMAT 2 TO EXTERNAL FORMAT
IF $LENGTH(OCXDT)
IF (OCXDT?1.2N1"/"1.2N.1" ".2N.1":".2N)
Begin DoDot:1
+15 NEW OCXMON
+16 SET OCXMON=$PIECE("January^February^March^April^May^June^July^August^September^October^November^December",U,$PIECE(OCXDT,"/",1))
+17 IF $LENGTH($PIECE(OCXDT," ",2))
SET OCXDT=OCXMON_" "_$PIECE($PIECE(OCXDT," ",1),"/",2)_"@"_$TRANSLATE($PIECE(OCXDT," ",2),":","")
+18 IF '$TEST
SET OCXDT=OCXMON_" "_$PIECE($PIECE(OCXDT," ",1),"/",2)
End DoDot:1
+19 ;
+20 ; EXTERNAL EXPERT SYSTEM FORMAT 3 TO EXTERNAL FORMAT
IF $LENGTH(OCXDT)
IF (OCXDT?1.2N1"/"1.2N1"/"1.2N.1" ".2N.1":".2N)
Begin DoDot:1
+21 NEW OCXMON
+22 SET OCXMON=$PIECE("January^February^March^April^May^June^July^August^September^October^November^December",U,$PIECE(OCXDT,"/",1))
+23 IF $LENGTH($PIECE(OCXDT," ",2))
SET OCXDT=OCXMON_" "_$PIECE($PIECE(OCXDT," ",1),"/",2)_","_$PIECE($PIECE(OCXDT," ",1),"/",3)_"@"_$TRANSLATE($PIECE(OCXDT," ",2),":","")
+24 IF '$TEST
SET OCXDT=OCXMON_" "_$PIECE($PIECE(OCXDT," ",1),"/",2)_", "_$PIECE($PIECE(OCXDT," ",1),"/",3)
End DoDot:1
+25 ;
+26 ; EXTERNAL FORMAT TO INTERNAL FILEMAN FORMAT
IF $LENGTH(OCXDT)
IF 'OCXDT
Begin DoDot:1
+27 IF (OCXDT["@0000")
SET OCXDT=$PIECE(OCXDT,"@",1)
SET OCXDIFF=1
+28 NEW %DT,X,Y
SET X=OCXDT
SET %DT=""
IF (OCXDT["@")!(OCXDT="N")
SET %DT="T"
DO ^%DT
SET OCXDT=+Y
End DoDot:1
+29 ;
+30 ; HL7 FORMAT TO INTERNAL FILEMAN FORMAT
IF ($LENGTH(OCXDT\1)>7)
SET OCXDT=$$HL7TFM^XLFDT(OCXDT)
+31 ;
+32 ; INTERNAL FILEMAN FORMAT TO $H FORMAT
IF ($LENGTH(OCXDT\1)=7)
SET OCXDT=$$FMTH^XLFDT(+OCXDT)
+33 ;
+34 ; $H FORMAT TO EXPERT SYSTEM INTERNAL FORMAT
IF (OCXDT?5N1","1.5N)
SET OCXVAL=(OCXDT*86400)+$PIECE(OCXDT,",",2)
+35 ;
+36 QUIT OCXVAL
+37 ;
