OCXOERR.m

OCXOERR ;SLC/RJS,CLA - External Interface - PROCESS OERR ORDER EVENT ;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

 ;

 ;

 Q

SILENT(OCXORD,OUTMSG) ;

 ;

 N OCXRDT,OCXOZZT

 S OCXRDT=($H*86400+$P($H,",",2))

 S:'$D(OUTMSG) OUTMSG=""

 D CHECK(OCXORD,.OUTMSG)

 Q

VERBOSE(OCXORD) ;

 ;

 N OCXX,OUTMSG,OCXOZZT

 S OCXRDT=($H*86400+$P($H,",",2))

 S OUTMSG=""

 D CHECK(OCXORD,.OUTMSG)

 W:$O(OUTMSG(0)) !,"Order Check Message: ",$C(7)

 S OCXX=0 F  S OCXX=$O(OUTMSG(OCXX)) Q:'OCXX  W !,OUTMSG(OCXX)

 W:$O(OUTMSG(0)) !,$C(7)

 Q

 ;

CHECK(OCXORD,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=+OCXORD

 S X="N",%DT="T" D ^%DT S OCXORDT=+Y

 Q:'DFN

 ;

 S (OCXTEST,OCXDATA)=""

 S OCXOSRC="CPRS ORDER PROTOCOL"

 ;

 S OCXOLOG=$$LOG(OCXORD)

 ;

 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(OCXORD) ;

 ;   Log Messages

 ;

 I $G(OCXTRACE),$$CDATA^OCXOZ01 Q 0

 Q:'$L($T(LOG^OCXOZ01)) 0 Q:'$$LOG^OCXOZ01 0

 N OCXDFN,OCXNL

 S OCXARY="OCXNL"

 S OCXNL(1)="OCXORD="_OCXORD

 Q $$NEW^OCXOLOG(OCXARY,"OERR",+$G(DUZ),+OCXORD)

 ;

ERROR Q

 ;

 ; **** Old Labels to insure backwards compatibility ****

 ;

PROC(OCXORD,OUTMSG) ;

 D SILENT(OCXORD,.OUTMSG)

 Q

 ;

EN(OCXORD) ;

 N OUTMSG S OUTMSG=""

 D SILENT(OCXORD,.OUTMSG) Q

 ;

OCXOERR   ;SLC/RJS,CLA - External Interface - PROCESS OERR ORDER EVENT ;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       ;

 +4       ;

 +5        QUIT 

SILENT(OCXORD,OUTMSG) ;

 +1       ;

 +2        NEW OCXRDT,OCXOZZT

 +3        SET OCXRDT=($HOROLOG*86400+$PIECE($HOROLOG,",",2))

 +4        IF '$DATA(OUTMSG)

               SET OUTMSG=""

 +5        DO CHECK(OCXORD,.OUTMSG)

 +6        QUIT 

VERBOSE(OCXORD) ;

 +1       ;

 +2        NEW OCXX,OUTMSG,OCXOZZT

 +3        SET OCXRDT=($HOROLOG*86400+$PIECE($HOROLOG,",",2))

 +4        SET OUTMSG=""

 +5        DO CHECK(OCXORD,.OUTMSG)

 +6        IF $ORDER(OUTMSG(0))

               WRITE !,"Order Check Message: ",$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(OCXORD,OUTMSG) ;

 +1       ;

 +2        IF $$RTEST

               Begin DoDot:1

 +3                NEW OMSG,OTMOUT,OCXM

 +4                SET OMSG="^25^^Order Checking is recompiling and momentarily disabled"

 +5                SET OCXM=0

                   FOR 

                       SET OCXM=$ORDER(OUTMSG(OCXM))

                       IF 'OCXM

                           QUIT 

                       IF (OUTMSG(OCXM)[OMSG)

                           QUIT 

 +6                IF OCXM

                       QUIT 

 +7                SET OUTMSG($ORDER(OUTMSG(""),-1)+1)=OMSG

               End DoDot:1

               QUIT 

 +8       ;

 +9        NEW OCXSUB,OCXTEST,OCXDATA,OCXEL,OCXSEG0,DFN,%DT,X,Y

 +10       NEW OCXOLOG,OCXORDT,OCXOSRC

 +11      ;

 +12       SET DFN=+OCXORD

 +13       SET X="N"

           SET %DT="T"

           DO ^%DT

           SET OCXORDT=+Y

 +14       IF 'DFN

               QUIT 

 +15      ;

 +16       SET (OCXTEST,OCXDATA)=""

 +17       SET OCXOSRC="CPRS ORDER PROTOCOL"

 +18      ;

 +19       SET OCXOLOG=$$LOG(OCXORD)

 +20      ;

 +21       DO UPDATE^OCXOZ01(DFN,OCXOSRC,.OUTMSG)

 +22      ;

 +23       DO FINISH^OCXOLOG(OCXOLOG)

 +24      ;

 +25       QUIT 

 +26      ;

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(OCXORD) ;

 +1       ;   Log Messages

 +2       ;

 +3        IF $GET(OCXTRACE)

               IF $$CDATA^OCXOZ01

                   QUIT 0

 +4        IF '$LENGTH($TEXT(LOG^OCXOZ01))

               QUIT 0

           IF '$$LOG^OCXOZ01

               QUIT 0

 +5        NEW OCXDFN,OCXNL

 +6        SET OCXARY="OCXNL"

 +7        SET OCXNL(1)="OCXORD="_OCXORD

 +8        QUIT $$NEW^OCXOLOG(OCXARY,"OERR",+$GET(DUZ),+OCXORD)

 +9       ;

ERROR      QUIT 

 +1       ;

 +2       ; **** Old Labels to insure backwards compatibility ****

 +3       ;

PROC(OCXORD,OUTMSG) ;

 +1        DO SILENT(OCXORD,.OUTMSG)

 +2        QUIT 

 +3       ;

EN(OCXORD) ;

 +1        NEW OUTMSG

           SET OUTMSG=""

 +2        DO SILENT(OCXORD,.OUTMSG)

           QUIT 

 +3       ;