ORMTIME.m

ORMTIME ; SLC/RJS - PROCESS TIME BASED EVENT ;Aug 26, 2021@13:15:12

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**40,253,243,377,571,405**;Dec 17, 1997;Build 211

 ;

EN ; Main entry tag.

 ;

 N OCXPSDT,OCXZTSK,OCXERR,OCXORMTR,OCXSTDT,OCXLOCK,OCXPAR

 K ^TMP("OCXORMTIME",$J)

 S OCXLOCK=0

 S OCXORMTR="ORMTIME: Startup"

 S OCXSTDT=$$EDATE($$IDATE("NOW"))

 S ^TMP("OCXORMTIME",$J,"STATUS")="ORMTIME: Attempting to lock ^OR(100,""AE"") at "_OCXSTDT_"."

 L +^OR(100,"AE"):10

 I  D

 .S OCXLOCK=1

 .D SCAN

 .L -^OR(100,"AE")

 .K ^TMP("OCXORMTIME")

 .S OCXPAR=$$IDATE2("NOW")

 .D PUT^XPAR("SYS","ORM ORMTIME LAST RUN",1,OCXPAR,.OCXERR)

 S:'OCXLOCK ^TMP("OCXORMTIME",$J,"STATUS")="ORMTIME: Unable to lock ^OR(100,""AE"") at "_OCXSTDT_" attempt."

 Q

 ;

SCAN ; Call ORMTIM01 for order checking, etc.  ORMTIM02 for misc time based tasks

 ;

 D SCAN^ORMTIM01

 D MISC^ORMTIM02

 D TASK^ORTSKLPS

 D GENERATE^ORBSMART

 D GENALRTS^ORB3UTL

 D CLEAN^ORWTIU ;Clean-up copy/paste ^XTMP entries that have expired

 Q

 ;

EDATE(Y) X ^DD("DD") S:(Y["@") Y=$P(Y,"@",1)_" at "_$P(Y,"@",2) Q Y

 ;

IDATE(X) N %DT,Y S %DT="F" D ^%DT Q Y

 ;

IDATE2(X) N %DT,Y S %DT="TF" D ^%DT Q Y

 ;

REQUEUE(ORMQT) ; Code formerly queued ORMTIME tasks in Taskman.

 ;

 ; (This tag kept for compatibility with outside calls.)

 ;

 Q

 ;

STATUS ; Check status of last ORMTIME run.

 ;

 N ORMLAST

 ;

 ; Get date/time of last ORMTIME run:

 S ORMLAST=$$GET^XPAR("SYS","ORM ORMTIME LAST RUN",1,"I")

 S ORMLAST=$$EDATE(ORMLAST) ; Convert to external format for display.

 ;

 ; Present information to user:

 W !

 W !,"     ORMTIME last ran "_ORMLAST_"."

 W !

 ;

 Q

 ;

BULL ; Send a bulletin if ORMTIME's last run is greater than 24 hours.

 ;

 N DIC,ORMMSG,X,XMSUB,XMTEXT,XMY,XMZ,Y,ORMLAST

 ;

 ; Don't send bulletin if ORMTIME STATUS mail group does not exist:

 S DIC=3.8,DIC(0)="",X="ORMTIME STATUS"

 D ^DIC Q:(+Y<0)

 ;

 S ORMLAST=$$GET^XPAR("SYS","ORM ORMTIME LAST RUN",1,"I")

 I $$FMDIFF^XLFDT($$IDATE2("NOW"),ORMLAST,2)>86400  D

 .S XMY("G.ORMTIME STATUS")=""

 .S XMSUB=" ORMTIME Warning"

 .S ORMMSG(1,0)=" "

 .S ORMMSG(2,0)="    The ORMTIME process last ran more than 24 hours ago. "

 .S ORMMSG(3,0)=" "

 .S ORMMSG(4,0)=" The ORMTIME background job handles activating and expiring orders,"

 .S ORMMSG(5,0)=" some time based notifications, as well as purging of temporary CPRS"

 .S ORMMSG(6,0)=" data. It is important that it runs regularly."

 .S ORMMSG(7,0)=" "

 .S ORMMSG(8,0)="    Assure that the scheduled option, ORMTIME RUN, is correctly implemented."

 .S ORMMSG(9,0)=" "

 .S XMTEXT="ORMMSG("

 .D ^XMD

 Q

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ORMTIME   2629     printed  Apr 23, 2025@18:46:47                                                                                                                                                                                                     Page 2

ORMTIME   ; SLC/RJS - PROCESS TIME BASED EVENT ;Aug 26, 2021@13:15:12

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**40,253,243,377,571,405**;Dec 17, 1997;Build 211

 +2       ;

EN        ; Main entry tag.

 +1       ;

 +2        NEW OCXPSDT,OCXZTSK,OCXERR,OCXORMTR,OCXSTDT,OCXLOCK,OCXPAR

 +3        KILL ^TMP("OCXORMTIME",$JOB)

 +4        SET OCXLOCK=0

 +5        SET OCXORMTR="ORMTIME: Startup"

 +6        SET OCXSTDT=$$EDATE($$IDATE("NOW"))

 +7        SET ^TMP("OCXORMTIME",$JOB,"STATUS")="ORMTIME: Attempting to lock ^OR(100,""AE"") at "_OCXSTDT_"."

 +8        LOCK +^OR(100,"AE"):10

 +9       IF $TEST

               Begin DoDot:1

 +10               SET OCXLOCK=1

 +11               DO SCAN

 +12               LOCK -^OR(100,"AE")

 +13               KILL ^TMP("OCXORMTIME")

 +14               SET OCXPAR=$$IDATE2("NOW")

 +15               DO PUT^XPAR("SYS","ORM ORMTIME LAST RUN",1,OCXPAR,.OCXERR)

               End DoDot:1

 +16       if 'OCXLOCK

               SET ^TMP("OCXORMTIME",$JOB,"STATUS")="ORMTIME: Unable to lock ^OR(100,""AE"") at "_OCXSTDT_" attempt."

 +17       QUIT 

 +18      ;

SCAN      ; Call ORMTIM01 for order checking, etc.  ORMTIM02 for misc time based tasks

 +1       ;

 +2        DO SCAN^ORMTIM01

 +3        DO MISC^ORMTIM02

 +4        DO TASK^ORTSKLPS

 +5        DO GENERATE^ORBSMART

 +6        DO GENALRTS^ORB3UTL

 +7       ;Clean-up copy/paste ^XTMP entries that have expired

           DO CLEAN^ORWTIU

 +8        QUIT 

 +9       ;

EDATE(Y)   XECUTE ^DD("DD")

           if (Y["@")

               SET Y=$PIECE(Y,"@",1)_" at "_$PIECE(Y,"@",2)

           QUIT Y

 +1       ;

IDATE(X)   NEW %DT,Y

           SET %DT="F"

           DO ^%DT

           QUIT Y

 +1       ;

IDATE2(X)  NEW %DT,Y

           SET %DT="TF"

           DO ^%DT

           QUIT Y

 +1       ;

REQUEUE(ORMQT) ; Code formerly queued ORMTIME tasks in Taskman.

 +1       ;

 +2       ; (This tag kept for compatibility with outside calls.)

 +3       ;

 +4        QUIT 

 +5       ;

STATUS    ; Check status of last ORMTIME run.

 +1       ;

 +2        NEW ORMLAST

 +3       ;

 +4       ; Get date/time of last ORMTIME run:

 +5        SET ORMLAST=$$GET^XPAR("SYS","ORM ORMTIME LAST RUN",1,"I")

 +6       ; Convert to external format for display.

           SET ORMLAST=$$EDATE(ORMLAST)

 +7       ;

 +8       ; Present information to user:

 +9        WRITE !

 +10       WRITE !,"     ORMTIME last ran "_ORMLAST_"."

 +11       WRITE !

 +12      ;

 +13       QUIT 

 +14      ;

BULL      ; Send a bulletin if ORMTIME's last run is greater than 24 hours.

 +1       ;

 +2        NEW DIC,ORMMSG,X,XMSUB,XMTEXT,XMY,XMZ,Y,ORMLAST

 +3       ;

 +4       ; Don't send bulletin if ORMTIME STATUS mail group does not exist:

 +5        SET DIC=3.8

           SET DIC(0)=""

           SET X="ORMTIME STATUS"

 +6        DO ^DIC

           if (+Y<0)

               QUIT 

 +7       ;

 +8        SET ORMLAST=$$GET^XPAR("SYS","ORM ORMTIME LAST RUN",1,"I")

 +9        IF $$FMDIFF^XLFDT($$IDATE2("NOW"),ORMLAST,2)>86400

               Begin DoDot:1

 +10               SET XMY("G.ORMTIME STATUS")=""

 +11               SET XMSUB=" ORMTIME Warning"

 +12               SET ORMMSG(1,0)=" "

 +13               SET ORMMSG(2,0)="    The ORMTIME process last ran more than 24 hours ago. "

 +14               SET ORMMSG(3,0)=" "

 +15               SET ORMMSG(4,0)=" The ORMTIME background job handles activating and expiring orders,"

 +16               SET ORMMSG(5,0)=" some time based notifications, as well as purging of temporary CPRS"

 +17               SET ORMMSG(6,0)=" data. It is important that it runs regularly."

 +18               SET ORMMSG(7,0)=" "

 +19               SET ORMMSG(8,0)="    Assure that the scheduled option, ORMTIME RUN, is correctly implemented."

 +20               SET ORMMSG(9,0)=" "

 +21               SET XMTEXT="ORMMSG("

 +22               DO ^XMD

               End DoDot:1

 +23       QUIT 

 +24      ;