XUWORKDY.m

XUWORKDY ;SF/GJL - WORKDAYS Mon-Fri ;09/04/98  13:29 [ 04/02/2003   8:29 AM ]

 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003

 ;;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

XUWORKDY  ;SF/GJL - WORKDAYS Mon-Fri ;09/04/98  13:29 [ 04/02/2003   8:29 AM ]

 +1       ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003

 +2       ;;8.0;KERNEL;**65,71,77,91**;Jul 10, 1995

 +3       ;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