83 lines
1.8 KiB
Mathematica
83 lines
1.8 KiB
Mathematica
OCXGENE ;SLC/RJS,CLA - External Interface - PROCESS GENERIC RESULT REQUESTS;3/1/99 12:37
|
|
;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
|
|
;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
|
|
;
|
|
;
|
|
Q
|
|
EN(OUTMSG,OCXDFN,OCXGND,OCXGNM) ;
|
|
;
|
|
N OCXRDT,OCXOZZT
|
|
S OCXRDT=($H*86400+$P($H,",",2))
|
|
S:'$D(OUTMSG) OUTMSG=""
|
|
D CHECK(OCXGND,OCXGNM,OCXDFN,.OUTMSG)
|
|
Q
|
|
VERBOSE(OCXGND,OCXGNM,OCXDFN) ;
|
|
;
|
|
N OCXX,OUTMSG,OCXOZZT
|
|
S OCXRDT=($H*86400+$P($H,",",2))
|
|
S OUTMSG=""
|
|
D CHECK(OCXGND,OCXGNM,OCXDFN,.OUTMSG)
|
|
W:$O(OUTMSG(0)) !,"Generic Query Results: ",$C(7)
|
|
S OCXX=0 F S OCXX=$O(OUTMSG(OCXX)) Q:'OCXX W !,OUTMSG(OCXX)
|
|
W:$O(OUTMSG(0)) !,$C(7)
|
|
Q
|
|
;
|
|
CHECK(OCXGND,OCXGNM,OCXDFN,OUTMSG) ;
|
|
;
|
|
;
|
|
I $$RTEST D Q
|
|
.N OMSG,OTMOUT,OCXM
|
|
.S OMSG="^25^^Order Checking is recompiling and momentarily disabled"
|
|
.S OCXM=0 F S OCXM=$O(OUTMSG(OCXM)) Q:'OCXM Q:(OUTMSG(OCXM)[OMSG)
|
|
.Q:OCXM
|
|
.S OUTMSG($O(OUTMSG(""),-1)+1)=OMSG
|
|
;
|
|
;
|
|
N OCXSUB,OCXTEST,OCXDATA,OCXEL,OCXSEG0,DFN,%DT,X,Y
|
|
N OCXOLOG,OCXORDT,OCXOSRC
|
|
;
|
|
S DFN=+OCXDFN
|
|
S X="N",%DT="T" D ^%DT S OCXORDT=+Y
|
|
Q:'DFN
|
|
;
|
|
S (OCXTEST,OCXDATA)=""
|
|
S OCXOSRC="GENERIC QUERY"
|
|
;
|
|
S OCXOLOG=$$LOG(OCXGND,OCXGNM)
|
|
;
|
|
D UPDATE^OCXOZ01(DFN,OCXOSRC,.OUTMSG)
|
|
;
|
|
D FINISH^OCXOLOG(OCXOLOG)
|
|
;
|
|
Q
|
|
;
|
|
;
|
|
RTEST() ;
|
|
N DATE,TMOUT
|
|
Q:'$L($T(^OCXOZ01)) 1
|
|
I '($P($G(^OCXD(861,1,0)),U,1)="SITE PREFERENCES") K ^OCXD(861,1) S ^OCXD(861,1,0)="SITE PREFERENCES"
|
|
S DATE=$P($G(^OCXD(861,1,0)),U,3)
|
|
I DATE,((+DATE)=(+$H)),(((+$P($H,",",2))-(+$P(DATE,",",2)))<1800) Q 1
|
|
Q 0
|
|
;
|
|
LOG(OCXGND,OCXGNM) ;
|
|
;
|
|
; Log Messages
|
|
;
|
|
I $G(OCXTRACE),$$CDATA^OCXOZ01 Q 0
|
|
Q:'$L($T(LOG^OCXOZ01)) 0 Q:'$$LOG^OCXOZ01 0
|
|
N OCXNL
|
|
S OCXARY="OCXNL"
|
|
S OCXNL(1)="OCXGND="_OCXGND
|
|
S OCXNL(2)="OCXGNM="_OCXGNM
|
|
Q $$NEW^OCXOLOG(OCXARY,"QUERY",+$G(DUZ),+OCXDFN)
|
|
;
|
|
ERROR Q
|
|
;
|
|
;
|
|
; **** Old Labels to insure backwards compatibility ****
|
|
;
|
|
PROC(OCXORD) ;
|
|
D VERBOSE(OCXORD) Q
|
|
;
|