XLFDT4.m

XLFDT4 ;ISCSF/RWF - Exclude time ;7/8/94  07:58

 ;;8.0;KERNEL;**71**;Jul 10, 1995

 Q

WI(XLSCH,XLRD) ;Test Entry Point

WITHIN ;EF. Called from XLFDT, Return 1 XLRD is in XLSCH, else 0.

 ;XLSCH contact schedule, XLRD Reference date

 N XL1,XLCT,XLDOW,XLFOK

 S:'$D(XLRD) XLRD=$$NOW^XLFDT()

 Q:XLSCH="ANY" 1

 S XLCT=$E($P(XLRD,".",2)_"0000",1,4),XLDOW=$E("UMTWRFS",$$FMTH^XLFDT(XLRD)+4#7+1)

 F XL1=1:1:$L(XLSCH,",") S XLFOK=$$CHECK(XLCT,XLDOW,$P(XLSCH,",",XL1)) Q:XLFOK

 Q XLFOK

CHECK(XLT,XLD,XLS) ;EF. Check one time.

 ;XLT is reference time, XLD is reference DOW, XLS is schedule

 N %,XLT1,XLT2,XLDP,XLTP,XLNEG,XLOK

 I XLS?1U.E D

 . I XLS?1U S XLDP=XLS,XLTP=""

 . E  F I=1:1:$L(XLS) I $E(XLS,I)?1N S XLDP=$E(XLS,1,I-1),XLTP=$E(XLS,I,$L(XLS)) Q

 . Q

 E  S XLDP="",XLTP=XLS

 S XLT1=$P(XLTP,"-"),XLT2=$P(XLTP,"-",2) S:XLT2="" XLT2=XLT1

 I XLT1<XLT2 S XLNEG=0

 E  S XLNEG=1,%=XLT1,XLT1=XLT2,XLT2=%

 S XLOK=(XLDP="")!(XLDP="ANY")!((XLDP="D")&("SU"'[XLD))!((XLDP="E")&("SU"[XLD))!(XLDP[XLD) Q:'XLOK 0

 S XLOK=(XLTP="")!(((XLT1'>XLT)&(XLT'>XLT2))'=XLNEG) Q:'XLOK 0

 Q 1

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---XLFDT4   1086     printed  Apr 09, 2024@21:16:41                                                                                                                                                                                                      Page 2

XLFDT4    ;ISCSF/RWF - Exclude time ;7/8/94  07:58

 +1       ;;8.0;KERNEL;**71**;Jul 10, 1995

 +2        QUIT 

WI(XLSCH,XLRD) ;Test Entry Point

WITHIN    ;EF. Called from XLFDT, Return 1 XLRD is in XLSCH, else 0.

 +1       ;XLSCH contact schedule, XLRD Reference date

 +2        NEW XL1,XLCT,XLDOW,XLFOK

 +3        if '$DATA(XLRD)

               SET XLRD=$$NOW^XLFDT()

 +4        if XLSCH="ANY"

               QUIT 1

 +5        SET XLCT=$EXTRACT($PIECE(XLRD,".",2)_"0000",1,4)

           SET XLDOW=$EXTRACT("UMTWRFS",$$FMTH^XLFDT(XLRD)+4#7+1)

 +6        FOR XL1=1:1:$LENGTH(XLSCH,",")

               SET XLFOK=$$CHECK(XLCT,XLDOW,$PIECE(XLSCH,",",XL1))

               if XLFOK

                   QUIT 

 +7        QUIT XLFOK

CHECK(XLT,XLD,XLS) ;EF. Check one time.

 +1       ;XLT is reference time, XLD is reference DOW, XLS is schedule

 +2        NEW %,XLT1,XLT2,XLDP,XLTP,XLNEG,XLOK

 +3        IF XLS?1U.E

               Begin DoDot:1

 +4                IF XLS?1U

                       SET XLDP=XLS

                       SET XLTP=""

 +5               IF '$TEST

                       FOR I=1:1:$LENGTH(XLS)

                           IF $EXTRACT(XLS,I)?1N

                               SET XLDP=$EXTRACT(XLS,1,I-1)

                               SET XLTP=$EXTRACT(XLS,I,$LENGTH(XLS))

                               QUIT 

 +6                QUIT 

               End DoDot:1

 +7       IF '$TEST

               SET XLDP=""

               SET XLTP=XLS

 +8        SET XLT1=$PIECE(XLTP,"-")

           SET XLT2=$PIECE(XLTP,"-",2)

           if XLT2=""

               SET XLT2=XLT1

 +9        IF XLT1<XLT2

               SET XLNEG=0

 +10      IF '$TEST

               SET XLNEG=1

               SET %=XLT1

               SET XLT1=XLT2

               SET XLT2=%

 +11       SET XLOK=(XLDP="")!(XLDP="ANY")!((XLDP="D")&("SU"'[XLD))!((XLDP="E")&("SU"[XLD))!(XLDP[XLD)

           if 'XLOK

               QUIT 0

 +12       SET XLOK=(XLTP="")!(((XLT1'>XLT)&(XLT'>XLT2))'=XLNEG)

           if 'XLOK

               QUIT 0

 +13       QUIT 1