XLFDT2 ;SEA/RDS - Library function Schedule ;03/21/2006
;;8.0;KERNEL;**71,86,141,414**;Jul 10, 1995;Build 1
;
DECODE() ;SCH^XLFDT--Decode A Cycle Schedule String (Return Next Time)
N %1,%D,%M,%T,%Y,Y,SCHL,LTMA,LTFM
I $L(+LTM)>6 S LTFM=LTM,LTM=$$FMTH^XLFDT(LTM)
A D NEXT Q:Y="" Y
I $G(FF),Y<$H S LTM=Y G A
I $G(FF),(+Y=+$H),$P(Y,",",2)'>$P($H,",",2) S LTM=Y G A
Q $$HTFM^XLFDT(Y)
;
NEXT ;
I SCH?1.4N1"S" S Y=$P(SCH,"S")+$P(LTM,",",2),Y=(Y\86400+LTM)_","_(Y#86400) Q
I SCH?1.4N1"H" S Y=$P(SCH,"H")*3600+$P(LTM,",",2),Y=(Y\86400+LTM)_","_(Y#86400) Q
I SCH?1.3N1"D" S Y=($P(SCH,"D")+LTM)_","_$P(LTM,",",2) Q
;I SCH?1.3N1"D@".E S X=$P(SCH,"@",2),%DT="RS" D ^%DT Q:Y=-1 S X=Y D H^%DTC S Y=($P(SCH,"D")+LTM)_","_%T Q
I SCH?1.2N1"M" D MONTH Q
I SCH?1.2N1"M(".E1")" S SCHL=$P($P(SCH,")"),"(",2) D MONTH2^XLFDT3 Q
I SCH?5.7N1P.5N.1";".E D LIST Q
I "MTWRFSUDE"[$E(SCH),"@,"[$E(SCH,2),SCH]"" D WEEK Q
S Y="" Q
;
MONTH ;DECODE--Simple Month Increment (Add x Months)
N X,XL,XLA,%,%H,%Y,%M,%D,%T
S %H=LTM D YMD^XLFDT ;Break into %Y %M %D
S XL=$P(SCH,"M") F Q:'XL S %M=%M+1,XL=XL-1 I %M=13 S %Y=%Y+1,%M=1
S XLA="31^"_($$LEAP(%Y)+28)_"^31^30^31^30^31^31^30^31^30^31"
I %D>$P(XLA,"^",%M) S %D=$P(XLA,"^",%M)
S Y=$$FMTH^XLFDT(%Y_"00"+%M_"00"+%D_%T) ;Note %T has a leading '.'
Q
;
LIST ;DECODE--Find Next Run Time In List
N %A,XL
F %1=1:1 S XL=$P(SCH,";",%1) Q:XL="" S:$L(+XL)<7 XL=$$HTFM^XLFDT(XL) S %A(XL)=""
S Y=$O(%A($$NOW^XLFDT)) S:Y>0 Y=$$FMTH^XLFDT(Y)
Q
;
WEEK ;DECODE--List Of Day Of Week Specifications
N %A,%W,%Z,XL,XLT
S XL=$P(LTM,",",2),%T=XL#60/100+(XL#3600\60)/100+(XL\3600)/100,%W=LTM+4#7+1,%Z="0"_%T,%Y=""
F %1=1:1 S %Y=$P(SCH,",",%1) Q:%Y="" D ARRAY S:%A]"" %A(%A+XLT)=""
S %A=$O(%A(%T)),Y="" S:%A]"" XLT=%A#1,XLT=$E(XLT_0,2,3)*60+$E(XLT_"000",4,5)*60+$E(XLT_"00000",6,7),Y=%A\1+LTM_","_XLT Q
;
ARRAY ;WEEK Subroutine--Build Incident Array
S XL=$E(%Y),XLT="" D TIME:$P(%Y,"@",2)]"" S:XLT="" XLT=%T
S %A="" S:"UMTWRFS"[XL %A=$F("UMTWRFS",XL)-1,%A=$S(%A'=%W:6-%W+%A#7+1,XLT'>%T:6-%W+%A#7+1,1:0) S:XL="D" %A=$S(%W=1:1,%W=7:2,XLT'>%T:1+(%W=6*2),1:0)
;Mid week > Sat, Sat > Sun, Sun > Sat.
S:XL="E" %A=$S(%W>1&(%W<7):7-%W,XLT'>%T:$S(%W=1:6,1:1),1:0) Q
;
TIME ;ARRAY--Build Time Node For Incidents That Include Times
N %DT,X S %DT="RS",X="T@"_$P(%Y,"@",2) D ^%DT S XLT=$S(Y=-1:"",1:Y#1) Q
;
LEAP(%) ;Check if a Leap year
S:%<1700 %=%+1700
Q (%#4=0)&'(%#100=0)!(%#400=0)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXLFDT2 2467 printed Oct 16, 2024@18:03:28 Page 2
XLFDT2 ;SEA/RDS - Library function Schedule ;03/21/2006
+1 ;;8.0;KERNEL;**71,86,141,414**;Jul 10, 1995;Build 1
+2 ;
DECODE() ;SCH^XLFDT--Decode A Cycle Schedule String (Return Next Time)
+1 NEW %1,%D,%M,%T,%Y,Y,SCHL,LTMA,LTFM
+2 IF $LENGTH(+LTM)>6
SET LTFM=LTM
SET LTM=$$FMTH^XLFDT(LTM)
A DO NEXT
if Y=""
QUIT Y
+1 IF $GET(FF)
IF Y<$HOROLOG
SET LTM=Y
GOTO A
+2 IF $GET(FF)
IF (+Y=+$HOROLOG)
IF $PIECE(Y,",",2)'>$PIECE($HOROLOG,",",2)
SET LTM=Y
GOTO A
+3 QUIT $$HTFM^XLFDT(Y)
+4 ;
NEXT ;
+1 IF SCH?1.4N1"S"
SET Y=$PIECE(SCH,"S")+$PIECE(LTM,",",2)
SET Y=(Y\86400+LTM)_","_(Y#86400)
QUIT
+2 IF SCH?1.4N1"H"
SET Y=$PIECE(SCH,"H")*3600+$PIECE(LTM,",",2)
SET Y=(Y\86400+LTM)_","_(Y#86400)
QUIT
+3 IF SCH?1.3N1"D"
SET Y=($PIECE(SCH,"D")+LTM)_","_$PIECE(LTM,",",2)
QUIT
+4 ;I SCH?1.3N1"D@".E S X=$P(SCH,"@",2),%DT="RS" D ^%DT Q:Y=-1 S X=Y D H^%DTC S Y=($P(SCH,"D")+LTM)_","_%T Q
+5 IF SCH?1.2N1"M"
DO MONTH
QUIT
+6 IF SCH?1.2N1"M(".E1")"
SET SCHL=$PIECE($PIECE(SCH,")"),"(",2)
DO MONTH2^XLFDT3
QUIT
+7 IF SCH?5.7N1P.5N.1";".E
DO LIST
QUIT
+8 IF "MTWRFSUDE"[$EXTRACT(SCH)
IF "@,"[$EXTRACT(SCH,2)
IF SCH]""
DO WEEK
QUIT
+9 SET Y=""
QUIT
+10 ;
MONTH ;DECODE--Simple Month Increment (Add x Months)
+1 NEW X,XL,XLA,%,%H,%Y,%M,%D,%T
+2 ;Break into %Y %M %D
SET %H=LTM
DO YMD^XLFDT
+3 SET XL=$PIECE(SCH,"M")
FOR
if 'XL
QUIT
SET %M=%M+1
SET XL=XL-1
IF %M=13
SET %Y=%Y+1
SET %M=1
+4 SET XLA="31^"_($$LEAP(%Y)+28)_"^31^30^31^30^31^31^30^31^30^31"
+5 IF %D>$PIECE(XLA,"^",%M)
SET %D=$PIECE(XLA,"^",%M)
+6 ;Note %T has a leading '.'
SET Y=$$FMTH^XLFDT(%Y_"00"+%M_"00"+%D_%T)
+7 QUIT
+8 ;
LIST ;DECODE--Find Next Run Time In List
+1 NEW %A,XL
+2 FOR %1=1:1
SET XL=$PIECE(SCH,";",%1)
if XL=""
QUIT
if $LENGTH(+XL)<7
SET XL=$$HTFM^XLFDT(XL)
SET %A(XL)=""
+3 SET Y=$ORDER(%A($$NOW^XLFDT))
if Y>0
SET Y=$$FMTH^XLFDT(Y)
+4 QUIT
+5 ;
WEEK ;DECODE--List Of Day Of Week Specifications
+1 NEW %A,%W,%Z,XL,XLT
+2 SET XL=$PIECE(LTM,",",2)
SET %T=XL#60/100+(XL#3600\60)/100+(XL\3600)/100
SET %W=LTM+4#7+1
SET %Z="0"_%T
SET %Y=""
+3 FOR %1=1:1
SET %Y=$PIECE(SCH,",",%1)
if %Y=""
QUIT
DO ARRAY
if %A]""
SET %A(%A+XLT)=""
+4 SET %A=$ORDER(%A(%T))
SET Y=""
if %A]""
SET XLT=%A#1
SET XLT=$EXTRACT(XLT_0,2,3)*60+$EXTRACT(XLT_"000",4,5)*60+$EXTRACT(XLT_"00000",6,7)
SET Y=%A\1+LTM_","_XLT
QUIT
+5 ;
ARRAY ;WEEK Subroutine--Build Incident Array
+1 SET XL=$EXTRACT(%Y)
SET XLT=""
if $PIECE(%Y,"@",2)]""
DO TIME
if XLT=""
SET XLT=%T
+2 SET %A=""
if "UMTWRFS"[XL
SET %A=$FIND("UMTWRFS",XL)-1
SET %A=$SELECT(%A'=%W:6-%W+%A#7+1,XLT'>%T:6-%W+%A#7+1,1:0)
if XL="D"
SET %A=$SELECT(%W=1:1,%W=7:2,XLT'>%T:1+(%W=6*2),1:0)
+3 ;Mid week > Sat, Sat > Sun, Sun > Sat.
+4 if XL="E"
SET %A=$SELECT(%W>1&(%W<7):7-%W,XLT'>%T:$SELECT(%W=1:6,1:1),1:0)
QUIT
+5 ;
TIME ;ARRAY--Build Time Node For Incidents That Include Times
+1 NEW %DT,X
SET %DT="RS"
SET X="T@"_$PIECE(%Y,"@",2)
DO ^%DT
SET XLT=$SELECT(Y=-1:"",1:Y#1)
QUIT
+2 ;
LEAP(%) ;Check if a Leap year
+1 if %<1700
SET %=%+1700
+2 QUIT (%#4=0)&'(%#100=0)!(%#400=0)
