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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOCXGENE 1971 printed Dec 13, 2024@02:24:35 Page 2
OCXGENE ;SLC/RJS,CLA - External Interface - PROCESS GENERIC RESULT REQUESTS;3/1/99 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 ;
+4 ;
+5 QUIT
EN(OUTMSG,OCXDFN,OCXGND,OCXGNM) ;
+1 ;
+2 NEW OCXRDT,OCXOZZT
+3 SET OCXRDT=($HOROLOG*86400+$PIECE($HOROLOG,",",2))
+4 if '$DATA(OUTMSG)
SET OUTMSG=""
+5 DO CHECK(OCXGND,OCXGNM,OCXDFN,.OUTMSG)
+6 QUIT
VERBOSE(OCXGND,OCXGNM,OCXDFN) ;
+1 ;
+2 NEW OCXX,OUTMSG,OCXOZZT
+3 SET OCXRDT=($HOROLOG*86400+$PIECE($HOROLOG,",",2))
+4 SET OUTMSG=""
+5 DO CHECK(OCXGND,OCXGNM,OCXDFN,.OUTMSG)
+6 if $ORDER(OUTMSG(0))
WRITE !,"Generic Query Results: ",$CHAR(7)
+7 SET OCXX=0
FOR
SET OCXX=$ORDER(OUTMSG(OCXX))
if 'OCXX
QUIT
WRITE !,OUTMSG(OCXX)
+8 if $ORDER(OUTMSG(0))
WRITE !,$CHAR(7)
+9 QUIT
+10 ;
CHECK(OCXGND,OCXGNM,OCXDFN,OUTMSG) ;
+1 ;
+2 ;
+3 IF $$RTEST
Begin DoDot:1
+4 NEW OMSG,OTMOUT,OCXM
+5 SET OMSG="^25^^Order Checking is recompiling and momentarily disabled"
+6 SET OCXM=0
FOR
SET OCXM=$ORDER(OUTMSG(OCXM))
if 'OCXM
QUIT
if (OUTMSG(OCXM)[OMSG)
QUIT
+7 if OCXM
QUIT
+8 SET OUTMSG($ORDER(OUTMSG(""),-1)+1)=OMSG
End DoDot:1
QUIT
+9 ;
+10 ;
+11 NEW OCXSUB,OCXTEST,OCXDATA,OCXEL,OCXSEG0,DFN,%DT,X,Y
+12 NEW OCXOLOG,OCXORDT,OCXOSRC
+13 ;
+14 SET DFN=+OCXDFN
+15 SET X="N"
SET %DT="T"
DO ^%DT
SET OCXORDT=+Y
+16 if 'DFN
QUIT
+17 ;
+18 SET (OCXTEST,OCXDATA)=""
+19 SET OCXOSRC="GENERIC QUERY"
+20 ;
+21 SET OCXOLOG=$$LOG(OCXGND,OCXGNM)
+22 ;
+23 DO UPDATE^OCXOZ01(DFN,OCXOSRC,.OUTMSG)
+24 ;
+25 DO FINISH^OCXOLOG(OCXOLOG)
+26 ;
+27 QUIT
+28 ;
+29 ;
RTEST() ;
+1 NEW DATE,TMOUT
+2 if '$LENGTH($TEXT(^OCXOZ01))
QUIT 1
+3 IF '($PIECE($GET(^OCXD(861,1,0)),U,1)="SITE PREFERENCES")
KILL ^OCXD(861,1)
SET ^OCXD(861,1,0)="SITE PREFERENCES"
+4 SET DATE=$PIECE($GET(^OCXD(861,1,0)),U,3)
+5 IF DATE
IF ((+DATE)=(+$HOROLOG))
IF (((+$PIECE($HOROLOG,",",2))-(+$PIECE(DATE,",",2)))<1800)
QUIT 1
+6 QUIT 0
+7 ;
LOG(OCXGND,OCXGNM) ;
+1 ;
+2 ; Log Messages
+3 ;
+4 IF $GET(OCXTRACE)
IF $$CDATA^OCXOZ01
QUIT 0
+5 if '$LENGTH($TEXT(LOG^OCXOZ01))
QUIT 0
if '$$LOG^OCXOZ01
QUIT 0
+6 NEW OCXNL
+7 SET OCXARY="OCXNL"
+8 SET OCXNL(1)="OCXGND="_OCXGND
+9 SET OCXNL(2)="OCXGNM="_OCXGNM
+10 QUIT $$NEW^OCXOLOG(OCXARY,"QUERY",+$GET(DUZ),+OCXDFN)
+11 ;
ERROR QUIT
+1 ;
+2 ;
+3 ; **** Old Labels to insure backwards compatibility ****
+4 ;
PROC(OCXORD) ;
+1 DO VERBOSE(OCXORD)
QUIT
+2 ;
