OCXOEPS.m

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

EN(OUTMSG,OCXDFN,OCXPSD,OCXPSM) ;

 ;

 N OCXRDT,OCXOZZT

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

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

 D CHECK(OCXPSD,OCXPSM,OCXDFN,.OUTMSG)

 Q

VERBOSE(OCXPSD,OCXPSM,OCXDFN) ;

 ;

 N OCXX,OUTMSG,OCXOZZT

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

 S OUTMSG=""

 D CHECK(OCXPSD,OCXPSM,OCXDFN,.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(OCXPSD,OCXPSM,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="CPRS ORDER PRESCAN"

 ;

 S OCXOLOG=$$LOG(OCXPSD,OCXPSM)

 ;

 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(OCXPSD,OCXPSM) ;

 ;

 ;   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)="OCXPSD="_OCXPSD

 S OCXNL(2)="OCXPSM="_OCXPSM

 Q $$NEW^OCXOLOG(OCXARY,"OEPS",+$G(DUZ),+OCXDFN)

 ;

ERROR Q

 ;

 ;

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

 ;

PROC(OCXORD) ;

 D VERBOSE(OCXORD) Q

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---OCXOEPS   1977     printed  Mar 13, 2025@21:30:33                                                                                                                                                                                                     Page 2

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

EN(OUTMSG,OCXDFN,OCXPSD,OCXPSM) ;

 +1       ;

 +2        NEW OCXRDT,OCXOZZT

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

 +4        if '$DATA(OUTMSG)

               SET OUTMSG=""

 +5        DO CHECK(OCXPSD,OCXPSM,OCXDFN,.OUTMSG)

 +6        QUIT 

VERBOSE(OCXPSD,OCXPSM,OCXDFN) ;

 +1       ;

 +2        NEW OCXX,OUTMSG,OCXOZZT

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

 +4        SET OUTMSG=""

 +5        DO CHECK(OCXPSD,OCXPSM,OCXDFN,.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(OCXPSD,OCXPSM,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="CPRS ORDER PRESCAN"

 +20      ;

 +21       SET OCXOLOG=$$LOG(OCXPSD,OCXPSM)

 +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(OCXPSD,OCXPSM) ;

 +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)="OCXPSD="_OCXPSD

 +9        SET OCXNL(2)="OCXPSM="_OCXPSM

 +10       QUIT $$NEW^OCXOLOG(OCXARY,"OEPS",+$GET(DUZ),+OCXDFN)

 +11      ;

ERROR      QUIT 

 +1       ;

 +2       ;

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

 +4       ;

PROC(OCXORD) ;

 +1        DO VERBOSE(OCXORD)

           QUIT 

 +2       ;