| 1 | OCXOERR ;SLC/RJS,CLA - External Interface - PROCESS OERR ORDER EVENT ;10/29/98  12:37
 | 
|---|
| 2 |  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
 | 
|---|
| 3 |  ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
 | 
|---|
| 4 |  ;
 | 
|---|
| 5 |  ;
 | 
|---|
| 6 |  Q
 | 
|---|
| 7 | SILENT(OCXORD,OUTMSG) ;
 | 
|---|
| 8 |  ;
 | 
|---|
| 9 |  N OCXRDT,OCXOZZT
 | 
|---|
| 10 |  S OCXRDT=($H*86400+$P($H,",",2))
 | 
|---|
| 11 |  S:'$D(OUTMSG) OUTMSG=""
 | 
|---|
| 12 |  D CHECK(OCXORD,.OUTMSG)
 | 
|---|
| 13 |  Q
 | 
|---|
| 14 | VERBOSE(OCXORD) ;
 | 
|---|
| 15 |  ;
 | 
|---|
| 16 |  N OCXX,OUTMSG,OCXOZZT
 | 
|---|
| 17 |  S OCXRDT=($H*86400+$P($H,",",2))
 | 
|---|
| 18 |  S OUTMSG=""
 | 
|---|
| 19 |  D CHECK(OCXORD,.OUTMSG)
 | 
|---|
| 20 |  W:$O(OUTMSG(0)) !,"Order Check Message: ",$C(7)
 | 
|---|
| 21 |  S OCXX=0 F  S OCXX=$O(OUTMSG(OCXX)) Q:'OCXX  W !,OUTMSG(OCXX)
 | 
|---|
| 22 |  W:$O(OUTMSG(0)) !,$C(7)
 | 
|---|
| 23 |  Q
 | 
|---|
| 24 |  ;
 | 
|---|
| 25 | CHECK(OCXORD,OUTMSG) ;
 | 
|---|
| 26 |  ;
 | 
|---|
| 27 |  I $$RTEST D  Q
 | 
|---|
| 28 |  .N OMSG,OTMOUT,OCXM
 | 
|---|
| 29 |  .S OMSG="^25^^Order Checking is recompiling and momentarily disabled"
 | 
|---|
| 30 |  .S OCXM=0 F  S OCXM=$O(OUTMSG(OCXM)) Q:'OCXM  Q:(OUTMSG(OCXM)[OMSG)
 | 
|---|
| 31 |  .Q:OCXM
 | 
|---|
| 32 |  .S OUTMSG($O(OUTMSG(""),-1)+1)=OMSG
 | 
|---|
| 33 |  ;
 | 
|---|
| 34 |  N OCXSUB,OCXTEST,OCXDATA,OCXEL,OCXSEG0,DFN,%DT,X,Y
 | 
|---|
| 35 |  N OCXOLOG,OCXORDT,OCXOSRC
 | 
|---|
| 36 |  ;
 | 
|---|
| 37 |  S DFN=+OCXORD
 | 
|---|
| 38 |  S X="N",%DT="T" D ^%DT S OCXORDT=+Y
 | 
|---|
| 39 |  Q:'DFN
 | 
|---|
| 40 |  ;
 | 
|---|
| 41 |  S (OCXTEST,OCXDATA)=""
 | 
|---|
| 42 |  S OCXOSRC="CPRS ORDER PROTOCOL"
 | 
|---|
| 43 |  ;
 | 
|---|
| 44 |  S OCXOLOG=$$LOG(OCXORD)
 | 
|---|
| 45 |  ;
 | 
|---|
| 46 |  D UPDATE^OCXOZ01(DFN,OCXOSRC,.OUTMSG)
 | 
|---|
| 47 |  ;
 | 
|---|
| 48 |  D FINISH^OCXOLOG(OCXOLOG)
 | 
|---|
| 49 |  ;
 | 
|---|
| 50 |  Q
 | 
|---|
| 51 |  ;
 | 
|---|
| 52 | RTEST() ;
 | 
|---|
| 53 |  N DATE,TMOUT
 | 
|---|
| 54 |  Q:'$L($T(^OCXOZ01)) 1
 | 
|---|
| 55 |  I '($P($G(^OCXD(861,1,0)),U,1)="SITE PREFERENCES") K ^OCXD(861,1) S ^OCXD(861,1,0)="SITE PREFERENCES"
 | 
|---|
| 56 |  S DATE=$P($G(^OCXD(861,1,0)),U,3)
 | 
|---|
| 57 |  I DATE,((+DATE)=(+$H)),(((+$P($H,",",2))-(+$P(DATE,",",2)))<1800) Q 1
 | 
|---|
| 58 |  Q 0
 | 
|---|
| 59 |  ;
 | 
|---|
| 60 | LOG(OCXORD) ;
 | 
|---|
| 61 |  ;   Log Messages
 | 
|---|
| 62 |  ;
 | 
|---|
| 63 |  I $G(OCXTRACE),$$CDATA^OCXOZ01 Q 0
 | 
|---|
| 64 |  Q:'$L($T(LOG^OCXOZ01)) 0 Q:'$$LOG^OCXOZ01 0
 | 
|---|
| 65 |  N OCXDFN,OCXNL
 | 
|---|
| 66 |  S OCXARY="OCXNL"
 | 
|---|
| 67 |  S OCXNL(1)="OCXORD="_OCXORD
 | 
|---|
| 68 |  Q $$NEW^OCXOLOG(OCXARY,"OERR",+$G(DUZ),+OCXORD)
 | 
|---|
| 69 |  ;
 | 
|---|
| 70 | ERROR Q
 | 
|---|
| 71 |  ;
 | 
|---|
| 72 |  ; **** Old Labels to insure backwards compatibility ****
 | 
|---|
| 73 |  ;
 | 
|---|
| 74 | PROC(OCXORD,OUTMSG) ;
 | 
|---|
| 75 |  D SILENT(OCXORD,.OUTMSG)
 | 
|---|
| 76 |  Q
 | 
|---|
| 77 |  ;
 | 
|---|
| 78 | EN(OCXORD) ;
 | 
|---|
| 79 |  N OUTMSG S OUTMSG=""
 | 
|---|
| 80 |  D SILENT(OCXORD,.OUTMSG) Q
 | 
|---|
| 81 |  ;
 | 
|---|