BQISCHED ;PRXM/HC/ALA - Set scheduled tasks ; 22 Feb 2016 7:27 AM
;;2.7;ICARE MANAGEMENT SYSTEM;**1**;Dec 19, 2017;Build 12
;
EN ; Entry point
NEW DR,DIE,DA,DIC,DLAYGO,BI,FREQ,I,OPT,OPTN,OPTION,SAT,SUN,SDATM,SDOW,TIME,X
NEW DIFROM,CIEN,CDATM,CDATE,CTIME,DIFF,ERROR,Y
F BI=1:1 S OPT=$P($T(TSK+BI)," ;;",2,99) Q:OPT="" D
. S OPTION=$P(OPT,U,1),FREQ=$P(OPT,U,2)
. I OPT["BQI UPDATE MEAN USE",'$$PATCH^XPDUTL("BJPC*2.0*6") Q
. I OPT["BQI UPDATE MU CQM",'$$PATCH^XPDUTL("BGP*11.0*2") Q
. S OPTN=$$FIND(OPTION) Q:OPTN'>0
. I $O(^DIC(19.2,"B",OPTN,""))'="" D Q
.. S CIEN=$O(^DIC(19.2,"B",OPTN,""))
.. S CDATM=$P(^DIC(19.2,CIEN,0),U,2)
.. S CDATE=$P(CDATM,".",1),CTIME=$P(CDATM,".",2)
.. I CDATE>DT Q
.. S DIFF=$$FMDIFF^XLFDT(DT,CDATE,1)
.. S SDOW=$P(OPT,U,3)
.. ; If day of week is defined and the difference between today
.. ; and the time scheduled to run is not greater than 14 days, quit
.. I SDOW'="",DIFF'>14 Q
.. I SDOW="",DIFF'>2 Q
.. S SAT=$$SAT(DT)
.. S SUN=$$FMADD^XLFDT(SAT,1)
.. S FRI=$$FMADD^XLFDT(SAT,-1)
.. I SDOW="" S SDATM=$$FMADD^XLFDT(DT,1)_"."_CTIME
.. I SDOW="SAT" S SDATM=SAT_"."_CTIME
.. I SDOW="SUN" S SDATM=SUN_"."_CTIME
.. I SDOW="FRI" S SDATM=FRI_"."_CTIME
.. D RESCH^XUTMOPT(OPTION,SDATM,"",FREQ,"L",.ERROR)
. ;
. S OPTION=$P(OPT,U,1)
. S FREQ=$P(OPT,U,2)
. S SDOW=$P(OPT,U,3) I SDOW'="" D
.. S SAT=$$SAT(DT)
.. S SUN=$$FMADD^XLFDT(SAT,1)
.. S FRI=$$FMADD^XLFDT(SAT,-1)
. S TIME=$P(OPT,U,4),TIME=$$STRIP^BQIUL1(TIME,"0")
. I SDOW="" S SDATM=$$FMADD^XLFDT(DT,1)_"."_TIME
. I SDOW="SAT" S SDATM=SAT_"."_TIME
. I SDOW="SUN" S SDATM=SUN_"."_TIME
. I SDOW="FRI" S SDATM=FRI_"."_TIME
. D RESCH^XUTMOPT(OPTION,SDATM,"",FREQ,"L",.ERROR)
. S OPTN=$$FIND(OPTION) Q:OPTN'>0
. NEW DA,DIC,X,DLAYGO,Y
. S DA=$O(^DIC(19.2,"B",OPTN,"")) I DA="" D
.. S X=OPTION,DIC(0)="NL",DIC="^DIC(19.2,",DLAYGO=19.2
.. D ^DIC
.. S DA=+Y
. ;S BQIUPD(19.2,DA_",",9)="P"
. I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
. K SDOW,SAT,SUN,TIME
K BQIUPD
Q
;
FIND(X,F) ;EP - Find an option
S X=$O(^DIC(19,"B",X,0)) I X'>0 Q -1
Q X
;
SAT(RDATE) ;EP - Find the next Saturday date from the passed in date
NEW CDOW,FDATE,NDAYS
S CDOW=$$DOW^XLFDT(RDATE,1),NDAYS=6-CDOW
I NDAYS=0 S NDAYS=7
S FDATE=$$FMADD^XLFDT(RDATE,NDAYS)
Q FDATE
;
;
TSK ; TASK STRUCTURE - OPTION^FREQUENCY^DOW^TIME
;;BQI NIGHTLY BACKGROUND^1D^^2000
;;BQI UPDATE ALL REMINDERS^7D^FRI^1900
;;BQI UPDATE TASK^7D^SAT^0200
;;BQI UPDATE TREATMENT^7D^SUN^0900
;;BQI UPDATE CARE MGMT^7D^SAT^0600
BQISCHED ;PRXM/HC/ALA - Set scheduled tasks ; 22 Feb 2016 7:27 AM
+1 ;;2.7;ICARE MANAGEMENT SYSTEM;**1**;Dec 19, 2017;Build 12
+2 ;
EN ; Entry point
+1 NEW DR,DIE,DA,DIC,DLAYGO,BI,FREQ,I,OPT,OPTN,OPTION,SAT,SUN,SDATM,SDOW,TIME,X
+2 NEW DIFROM,CIEN,CDATM,CDATE,CTIME,DIFF,ERROR,Y
+3 FOR BI=1:1
SET OPT=$PIECE($TEXT(TSK+BI)," ;;",2,99)
IF OPT=""
QUIT
Begin DoDot:1
+4 SET OPTION=$PIECE(OPT,U,1)
SET FREQ=$PIECE(OPT,U,2)
+5 IF OPT["BQI UPDATE MEAN USE"
IF '$$PATCH^XPDUTL("BJPC*2.0*6")
QUIT
+6 IF OPT["BQI UPDATE MU CQM"
IF '$$PATCH^XPDUTL("BGP*11.0*2")
QUIT
+7 SET OPTN=$$FIND(OPTION)
IF OPTN'>0
QUIT
+8 IF $ORDER(^DIC(19.2,"B",OPTN,""))'=""
Begin DoDot:2
+9 SET CIEN=$ORDER(^DIC(19.2,"B",OPTN,""))
+10 SET CDATM=$PIECE(^DIC(19.2,CIEN,0),U,2)
+11 SET CDATE=$PIECE(CDATM,".",1)
SET CTIME=$PIECE(CDATM,".",2)
+12 IF CDATE>DT
QUIT
+13 SET DIFF=$$FMDIFF^XLFDT(DT,CDATE,1)
+14 SET SDOW=$PIECE(OPT,U,3)
+15 ; If day of week is defined and the difference between today
+16 ; and the time scheduled to run is not greater than 14 days, quit
+17 IF SDOW'=""
IF DIFF'>14
QUIT
+18 IF SDOW=""
IF DIFF'>2
QUIT
+19 SET SAT=$$SAT(DT)
+20 SET SUN=$$FMADD^XLFDT(SAT,1)
+21 SET FRI=$$FMADD^XLFDT(SAT,-1)
+22 IF SDOW=""
SET SDATM=$$FMADD^XLFDT(DT,1)_"."_CTIME
+23 IF SDOW="SAT"
SET SDATM=SAT_"."_CTIME
+24 IF SDOW="SUN"
SET SDATM=SUN_"."_CTIME
+25 IF SDOW="FRI"
SET SDATM=FRI_"."_CTIME
+26 DO RESCH^XUTMOPT(OPTION,SDATM,"",FREQ,"L",.ERROR)
End DoDot:2
QUIT
+27 ;
+28 SET OPTION=$PIECE(OPT,U,1)
+29 SET FREQ=$PIECE(OPT,U,2)
+30 SET SDOW=$PIECE(OPT,U,3)
IF SDOW'=""
Begin DoDot:2
+31 SET SAT=$$SAT(DT)
+32 SET SUN=$$FMADD^XLFDT(SAT,1)
+33 SET FRI=$$FMADD^XLFDT(SAT,-1)
End DoDot:2
+34 SET TIME=$PIECE(OPT,U,4)
SET TIME=$$STRIP^BQIUL1(TIME,"0")
+35 IF SDOW=""
SET SDATM=$$FMADD^XLFDT(DT,1)_"."_TIME
+36 IF SDOW="SAT"
SET SDATM=SAT_"."_TIME
+37 IF SDOW="SUN"
SET SDATM=SUN_"."_TIME
+38 IF SDOW="FRI"
SET SDATM=FRI_"."_TIME
+39 DO RESCH^XUTMOPT(OPTION,SDATM,"",FREQ,"L",.ERROR)
+40 SET OPTN=$$FIND(OPTION)
IF OPTN'>0
QUIT
+41 NEW DA,DIC,X,DLAYGO,Y
+42 SET DA=$ORDER(^DIC(19.2,"B",OPTN,""))
IF DA=""
Begin DoDot:2
+43 SET X=OPTION
SET DIC(0)="NL"
SET DIC="^DIC(19.2,"
SET DLAYGO=19.2
+44 DO ^DIC
+45 SET DA=+Y
End DoDot:2
+46 ;S BQIUPD(19.2,DA_",",9)="P"
+47 IF $DATA(BQIUPD)
DO FILE^DIE("","BQIUPD","ERROR")
+48 KILL SDOW,SAT,SUN,TIME
End DoDot:1
+49 KILL BQIUPD
+50 QUIT
+51 ;
FIND(X,F) ;EP - Find an option
+1 SET X=$ORDER(^DIC(19,"B",X,0))
IF X'>0
QUIT -1
+2 QUIT X
+3 ;
SAT(RDATE) ;EP - Find the next Saturday date from the passed in date
+1 NEW CDOW,FDATE,NDAYS
+2 SET CDOW=$$DOW^XLFDT(RDATE,1)
SET NDAYS=6-CDOW
+3 IF NDAYS=0
SET NDAYS=7
+4 SET FDATE=$$FMADD^XLFDT(RDATE,NDAYS)
+5 QUIT FDATE
+6 ;
+7 ;
TSK ; TASK STRUCTURE - OPTION^FREQUENCY^DOW^TIME
+1 ;;BQI NIGHTLY BACKGROUND^1D^^2000
+2 ;;BQI UPDATE ALL REMINDERS^7D^FRI^1900
+3 ;;BQI UPDATE TASK^7D^SAT^0200
+4 ;;BQI UPDATE TREATMENT^7D^SUN^0900
+5 ;;BQI UPDATE CARE MGMT^7D^SAT^0600
