XUWORKDY ;SF/GJL - WORKDAYS Mon-Fri ;09/04/98 13:29
;;8.0;KERNEL;**65,71,77,91**;Jul 10, 1995
;X,X1 are any two dates (YYYMMDD). X=Working Days Between
A N %A,%B,%D,%H,%I,%J,%K,%M,%Y,%Z
S %A=X,%B=X1,%Z=1 I %A>%B S X=%B,%B=%A,%A=X,%Z=-1
S %J=$$HDTC(%A) I %J<0 S X="" G EXIT ;Imprecise date
S %K=$$HDTC(%B) I %K<0 S X="" G EXIT
S %H=0,X=(%J+3#7>4)&(%K+3#7>4) ;I $O(^HOLIDAY(2000000))'>0 S X="" G EXIT
S %Y=%A-1 F %I=1:1 S %Y=$O(^HOLIDAY(%Y)) Q:(%Y'>0)!(%Y>%B) S %H=%H+1
F %J=%J:1 S %Y=%J#7 Q:((%Y=3)!(%J=%K)) S:%Y-2 X=X+1
F %K=%K:-1 S %Y=%K#7 Q:((%Y=3)!(%K=%J)) S:%Y-2 X=X+1
S %I=%K-%J I '%I S %Y=%J#7 S:(%Y'=2)&(%Y'=3) X=X+1
S X=(X+%I-%H-(%I\7*2))*%Z S:X X=X-%Z
EXIT K X1
Q
HDTC(X) ;Taken from H^%DTC
S %M=$E(X,4,5),%D=$E(X,6,7) I '%M!'%D S %Y=-1 Q -1
N %H S %H=$$FMTH^XLFDT(X)
S %Y=%H+4#7
Q %H
EN(X,X1) ;Function entry point
D A Q X
;
WORKDAY(X) ;This function will determine if the input date is a workday.
;InPut: Fileman date.
;OutPut: 1 is a workday, 0 not a workday
I $D(^HOLIDAY(X)) Q 0
S X=$$DOW^XLFDT(X) I (X["Saturday")!(X["Sunday") Q 0
Q 1
WORKPLUS(XUDAY,XUOFF) ;Find the date N working day +/- of date D1
N %X,%Y,%Z,%D ;%D direction, %X abs days, %Y Workdays, %Z temp
I XUOFF=0 Q XUDAY ;Return starting date
S %Y=0
S XUOFF=+$P(XUOFF,"."),%D=$S(XUOFF<0:-1,1:1),%X=(XUOFF\7*2)+XUOFF
F D Q:XUOFF=%Y
. S %Z=$$FMADD^XLFDT(XUDAY,%X)
. S %Y=$$EN(XUDAY,%Z)
. I XUOFF'=%Y S %X=%X+%D
. Q
Q %Z
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUWORKDY 1473 printed Dec 13, 2024@02:14:13 Page 2
XUWORKDY ;SF/GJL - WORKDAYS Mon-Fri ;09/04/98 13:29
+1 ;;8.0;KERNEL;**65,71,77,91**;Jul 10, 1995
+2 ;X,X1 are any two dates (YYYMMDD). X=Working Days Between
A NEW %A,%B,%D,%H,%I,%J,%K,%M,%Y,%Z
+1 SET %A=X
SET %B=X1
SET %Z=1
IF %A>%B
SET X=%B
SET %B=%A
SET %A=X
SET %Z=-1
+2 ;Imprecise date
SET %J=$$HDTC(%A)
IF %J<0
SET X=""
GOTO EXIT
+3 SET %K=$$HDTC(%B)
IF %K<0
SET X=""
GOTO EXIT
+4 ;I $O(^HOLIDAY(2000000))'>0 S X="" G EXIT
SET %H=0
SET X=(%J+3#7>4)&(%K+3#7>4)
+5 SET %Y=%A-1
FOR %I=1:1
SET %Y=$ORDER(^HOLIDAY(%Y))
if (%Y'>0)!(%Y>%B)
QUIT
SET %H=%H+1
+6 FOR %J=%J:1
SET %Y=%J#7
if ((%Y=3)!(%J=%K))
QUIT
if %Y-2
SET X=X+1
+7 FOR %K=%K:-1
SET %Y=%K#7
if ((%Y=3)!(%K=%J))
QUIT
if %Y-2
SET X=X+1
+8 SET %I=%K-%J
IF '%I
SET %Y=%J#7
if (%Y'=2)&(%Y'=3)
SET X=X+1
+9 SET X=(X+%I-%H-(%I\7*2))*%Z
if X
SET X=X-%Z
EXIT KILL X1
+1 QUIT
HDTC(X) ;Taken from H^%DTC
+1 SET %M=$EXTRACT(X,4,5)
SET %D=$EXTRACT(X,6,7)
IF '%M!'%D
SET %Y=-1
QUIT -1
+2 NEW %H
SET %H=$$FMTH^XLFDT(X)
+3 SET %Y=%H+4#7
+4 QUIT %H
EN(X,X1) ;Function entry point
+1 DO A
QUIT X
+2 ;
WORKDAY(X) ;This function will determine if the input date is a workday.
+1 ;InPut: Fileman date.
+2 ;OutPut: 1 is a workday, 0 not a workday
+3 IF $DATA(^HOLIDAY(X))
QUIT 0
+4 SET X=$$DOW^XLFDT(X)
IF (X["Saturday")!(X["Sunday")
QUIT 0
+5 QUIT 1
WORKPLUS(XUDAY,XUOFF) ;Find the date N working day +/- of date D1
+1 ;%D direction, %X abs days, %Y Workdays, %Z temp
NEW %X,%Y,%Z,%D
+2 ;Return starting date
IF XUOFF=0
QUIT XUDAY
+3 SET %Y=0
+4 SET XUOFF=+$PIECE(XUOFF,".")
SET %D=$SELECT(XUOFF<0:-1,1:1)
SET %X=(XUOFF\7*2)+XUOFF
+5 FOR
Begin DoDot:1
+6 SET %Z=$$FMADD^XLFDT(XUDAY,%X)
+7 SET %Y=$$EN(XUDAY,%Z)
+8 IF XUOFF'=%Y
SET %X=%X+%D
+9 QUIT
End DoDot:1
if XUOFF=%Y
QUIT
+10 QUIT %Z
