OCXOLOG ;SLC/RJS,CLA - MAINTAIN RAW DATA LOG ;10/29/98 12:37
;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
;
NEW(OCXA,OCXS,OCXU,OCXP) ;
;
; OCXA - ARRAY NAME
; OCXS - DATA SOURCE
; OCXU - USER
; OCXP - PATIENT
;
I '$D(^OCXD(861,1,0)) S ^OCXD(861,1,0)="SITE PREFERENCES"
F S OCXI=$O(^OCXD(861,"A"),-1)+1 L +^OCXD(861,OCXI):0 I Q:'$D(^OCXD(861,OCXI)) L -^OCXD(861,OCXI)
;
N OCXR,OCXTEMP,OCXD1,OCXD2
;
S OCXDT=$$DATE_" "
S OCXR(0)=OCXDT
S OCXR("ARRAY")=OCXA
S OCXR("JOB")=$J
S:$L($G(OCXS)) OCXR("SOURCE")=$G(OCXS)
S OCXR("VERSION")=$P($T(+3),";;",3)
S OCXR("STATUS")="RUNNING"
S:$G(OCXU) OCXR("USER")="["_OCXU_"] "_$P($G(^VA(200,+OCXU,0)),U,1)
S:$G(OCXP) OCXR("PATIENT")="["_OCXP_"] "_$P($G(^DPT(+OCXP,0)),U,1)
;
S OCXD1=0 F S OCXD1=$O(@OCXA@(OCXD1)) Q:'(OCXD1) D
.N OCXTXT
.S OCXTXT=@OCXA@(OCXD1)
.I ($L(OCXTXT)<200) S OCXR("DATA",$$LAST+1,0)=OCXTXT Q
.N OCXOVER,OCXOV0
.F Q:'$L(OCXTXT) D
..S OCXR("DATA",$$LAST+1,0)=$E(OCXTXT,1,200)
..S OCXTXT=$E(OCXTXT,201,$L(OCXTXT))
..S:$L(OCXTXT) OCXTXT=">>>"_OCXTXT
;
S:$O(OCXR("DATA",0)) OCXR("DATA",0)="^^"_$$LAST_"^"_$$LAST_"^"_$$TODAY
;
M ^OCXD(861,OCXI)=OCXR
S ^OCXD(861,"B",OCXDT,OCXI)=""
S $P(^OCXD(861,0),"^",3)=$P(^OCXD(861,0),"^",3)+1
S $P(^OCXD(861,0),"^",4)=OCXI
;
L -^OCXD(861,OCXI)
;
W:$G(OCXTRACE) !,"OCX Logging message ",OCXS," # ",OCXI
;
K OCXR,OCXTEMP,OCXD1,OCXD2
;
Q OCXI
;
FINISH(OCXL) ;
;
I $G(OCXL),$D(^OCXD(861,OCXL,0)) S ^OCXD(861,OCXL,"STATUS")="FINISHED NORMALLY AT "_$$DATE
Q
;
LAST() Q $O(OCXR("DATA",""),-1)
;
CLEAR N OCXX S OCXX=$P(^OCXD(861,0),U,1,2) K ^OCXD(861) S ^OCXD(861,0)=OCXX Q
;
DATE() N X,Y,%DT S X="N",%DT="ST" D ^%DT Q ((Y\1)+17000000)_"."_$E(1000000+((Y#1)*1000000),2,7)
;
TODAY() N X,Y,%DT S X="T",%DT="" D ^%DT Q Y
;
CONV(Y) Q:'(Y["@") Y Q $P(Y,"@",1)_" at "_$P(Y,"@",2,99)
;
PURGE ; Use this for an emergency purge of the raw data
; log in case of <diskfull> errors
N OCXX S OCXX=$P($G(^OCXD(861,0)),"^",1,2) Q:'$L(OCXX)
K ^OCXD(861) S ^OCXD(861,0)=OCXX
Q
;
OCXOLOG ;SLC/RJS,CLA - MAINTAIN RAW DATA LOG ;10/29/98 12:37
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
+2 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
+3 ;
NEW(OCXA,OCXS,OCXU,OCXP) ;
+1 ;
+2 ; OCXA - ARRAY NAME
+3 ; OCXS - DATA SOURCE
+4 ; OCXU - USER
+5 ; OCXP - PATIENT
+6 ;
+7 IF '$DATA(^OCXD(861,1,0))
SET ^OCXD(861,1,0)="SITE PREFERENCES"
+8 FOR
SET OCXI=$ORDER(^OCXD(861,"A"),-1)+1
LOCK +^OCXD(861,OCXI):0
IF $TEST
IF '$DATA(^OCXD(861,OCXI))
QUIT
LOCK -^OCXD(861,OCXI)
+9 ;
+10 NEW OCXR,OCXTEMP,OCXD1,OCXD2
+11 ;
+12 SET OCXDT=$$DATE_" "
+13 SET OCXR(0)=OCXDT
+14 SET OCXR("ARRAY")=OCXA
+15 SET OCXR("JOB")=$JOB
+16 IF $LENGTH($GET(OCXS))
SET OCXR("SOURCE")=$GET(OCXS)
+17 SET OCXR("VERSION")=$PIECE($TEXT(+3),";;",3)
+18 SET OCXR("STATUS")="RUNNING"
+19 IF $GET(OCXU)
SET OCXR("USER")="["_OCXU_"] "_$PIECE($GET(^VA(200,+OCXU,0)),U,1)
+20 IF $GET(OCXP)
SET OCXR("PATIENT")="["_OCXP_"] "_$PIECE($GET(^DPT(+OCXP,0)),U,1)
+21 ;
+22 SET OCXD1=0
FOR
SET OCXD1=$ORDER(@OCXA@(OCXD1))
IF '(OCXD1)
QUIT
Begin DoDot:1
+23 NEW OCXTXT
+24 SET OCXTXT=@OCXA@(OCXD1)
+25 IF ($LENGTH(OCXTXT)<200)
SET OCXR("DATA",$$LAST+1,0)=OCXTXT
QUIT
+26 NEW OCXOVER,OCXOV0
+27 FOR
IF '$LENGTH(OCXTXT)
QUIT
Begin DoDot:2
+28 SET OCXR("DATA",$$LAST+1,0)=$EXTRACT(OCXTXT,1,200)
+29 SET OCXTXT=$EXTRACT(OCXTXT,201,$LENGTH(OCXTXT))
+30 IF $LENGTH(OCXTXT)
SET OCXTXT=">>>"_OCXTXT
End DoDot:2
End DoDot:1
+31 ;
+32 IF $ORDER(OCXR("DATA",0))
SET OCXR("DATA",0)="^^"_$$LAST_"^"_$$LAST_"^"_$$TODAY
+33 ;
+34 MERGE ^OCXD(861,OCXI)=OCXR
+35 SET ^OCXD(861,"B",OCXDT,OCXI)=""
+36 SET $PIECE(^OCXD(861,0),"^",3)=$PIECE(^OCXD(861,0),"^",3)+1
+37 SET $PIECE(^OCXD(861,0),"^",4)=OCXI
+38 ;
+39 LOCK -^OCXD(861,OCXI)
+40 ;
+41 IF $GET(OCXTRACE)
WRITE !,"OCX Logging message ",OCXS," # ",OCXI
+42 ;
+43 KILL OCXR,OCXTEMP,OCXD1,OCXD2
+44 ;
+45 QUIT OCXI
+46 ;
FINISH(OCXL) ;
+1 ;
+2 IF $GET(OCXL)
IF $DATA(^OCXD(861,OCXL,0))
SET ^OCXD(861,OCXL,"STATUS")="FINISHED NORMALLY AT "_$$DATE
+3 QUIT
+4 ;
LAST() QUIT $ORDER(OCXR("DATA",""),-1)
+1 ;
CLEAR NEW OCXX
SET OCXX=$PIECE(^OCXD(861,0),U,1,2)
KILL ^OCXD(861)
SET ^OCXD(861,0)=OCXX
QUIT
+1 ;
DATE() NEW X,Y,%DT
SET X="N"
SET %DT="ST"
DO ^%DT
QUIT ((Y\1)+17000000)_"."_$EXTRACT(1000000+((Y#1)*1000000),2,7)
+1 ;
TODAY() NEW X,Y,%DT
SET X="T"
SET %DT=""
DO ^%DT
QUIT Y
+1 ;
CONV(Y) IF '(Y["@")
QUIT Y
QUIT $PIECE(Y,"@",1)_" at "_$PIECE(Y,"@",2,99)
+1 ;
PURGE ; Use this for an emergency purge of the raw data
+1 ; log in case of <diskfull> errors
+2 NEW OCXX
SET OCXX=$PIECE($GET(^OCXD(861,0)),"^",1,2)
IF '$LENGTH(OCXX)
QUIT
+3 KILL ^OCXD(861)
SET ^OCXD(861,0)=OCXX
+4 QUIT
+5 ;
