- XLFDT4 ;ISCSF/RWF - Exclude time ;7/8/94 07:58 [ 04/02/2003 8:29 AM ]
- ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
- ;;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
- XLFDT4 ;ISCSF/RWF - Exclude time ;7/8/94 07:58 [ 04/02/2003 8:29 AM ]
- +1 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
- +2 ;;8.0;KERNEL;**71**;Jul 10, 1995
- +3 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