- 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 ;
