- 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
