XQ92 ;SEA/JLI - DATE/TIME FOR PROHIBITED TIME/DAY ;7/23/91 14:11 ;4/6/92 1:02 PM [ 04/02/2003 8:29 AM ]
;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
;;8.0;KERNEL;;Jul 10, 1995
; ENTRY IS WITH DATE TIME IN FILEMANAGER FORMAT IN VARIABLE X
; INTERNAL ENTRY NUMBER OF OPTION IN +XQY
;
; ON RETURN X IS UNCHANGED IF NOT WITHIN A PROHIBITED TIME,
; NULL IF WITHIN A PROHIBITED TIME.
;
ENTRY ; Check that input values are legitimate
N %,%D,%H,%M,%T,%XQ1,%XQ2,%XQ3,%XQA,%XQB,%XQK,%XQK0,%XQK1,%XQK2
N %XQOP,%XQX,%Y,XQUEFLG
S %XQOP=3.91 D ENT2 I X'="" S %XQOP=3.92 D ENT2
K %XQOP,XQUEFLG
Q
ENT2 ;
Q:'$D(X)!'$D(XQY) Q:+X'>0 Q:'$D(^DIC(19,+XQY,0))
K %XQX G:'$D(^DIC(19,+XQY,%XQOP)) CHK0
; Check for data in multiple DAY/TIMES field
S %XQA=0 F %XQI=1:1 S %XQA=$O(^DIC(19,+XQY,%XQOP,%XQA)) Q:%XQA'>0 S %XQX(%XQI)=$P(^(%XQA,0),U,1)_$P(^(0),U,2)
K %XQA,%XQI G:$D(%XQX) CHKIT
;
CHK0 ; Check zero node for old prohibited time
Q:%XQOP=3.92 S %XQX(1)=$P(^DIC(19,+XQY,0),U,9) I '$L(%XQX(1)) K %XQX Q
CHKIT ; Check for time within prohibited period
S %XQA="MO,TU,WE,TH,FR,SA,SU,MO,TU,WE,TH,FR,SA,"
F %XQI=0:0 S %XQI=$O(%XQX(%XQI)) Q:%XQI'>0 D CHKONE
I '$D(%XQX) S X="" ; **** At this point set X to NULL if within a prohibited period.
;K %XQI,%XQX,%XQA
Q
CHKONE ; Check for within prohibited period, if so KILL %XQX
S %XQ1=+$P(%XQX(%XQI),"-",1),%XQ2=+$E($P(%XQX(%XQI),"-",2),1,4),%XQ3=+$E($P(X,".",2)_"0000",1,4)
I %XQ1>%XQ3!(%XQ3>%XQ2) Q ; Time is outside specified range
; Time is within range, what about day of week
S %XQ3=(%XQ2+1)#100,%XQB=%XQ2\100,%XQK1="" S:%XQB>23 %XQB=0,%XQK1=1 S:%XQ3>59 %XQB=%XQB+1,%XQ3=0 S %XQB=($P(X,".",1)+%XQK1)_"."_$S(%XQB>9:%XQB,1:"0"_%XQB)_$S(%XQ3>9:%XQ3,1:"0"_%XQ3)
S %XQ3=$E(%XQX(%XQI),10,100) I %XQ3="" S %XQ3="MO-FR"
F %XQK=0:0 S %XQK1=$F(%XQ3,"-")-3 Q:%XQK1'>0 S %XQK2=%XQK1+4,%XQK0=$E(%XQA,$F(%XQA,$E(%XQ3,%XQK1,%XQK1+1))-2,100),%XQK0=$E(%XQK0,1,$F(%XQK0,$E(%XQ3,%XQK2-1,%XQK2))-1),%XQ3=$E(%XQ3,1,%XQK1-1)_%XQK0_$E(%XQ3,%XQK2+1,100)
K %XQK,%XQK0,%XQK1,%XQK2 S %XQ1=%XQ3 I $D(^HOLIDAY($P(X,".",1),0)) S %XQ3="SU" ; Holiday, set day of week to Sunday
E S %XQ3=X D DOW^%DTC S X=%XQ3,%XQ3=$P("SU^MO^TU^WE^TH^FR^SA",U,Y+1)
I %XQ1[%XQ3 K %XQX ; Only a specific day, either good or bad
Q
;
XQO ; Entry from checking via menu mapping X=date/time, XQY=OPTION, XQZ=string
; of prohibited times/dates, joined by semicolons.
K %XQX F %XQI=1:1 S %XQ1=$P(XQZ,";",%XQI) Q:%XQ1="" S %XQX(%XQI)=%XQ1
I $D(%XQX) D CHKIT
K %XQ1,%XQ2,%XQ3,%XQA,%XQB,%XQI,%XQJ,%XQX
Q
;
NEXT ;Find next time which is NOT prohibited from current date/time
; Entry is with +Y equal to the option number
; Return is with the next non-prohibited date/time in X
I $G(Y)>0 N XQY S XQY=+Y
S %XQOP=$S($D(^DIC(19,+XQY,3.91)):3.91,$D(^(3.92)):3.92,1:3.91)
NENT ;
S X="N",%DT="T" D ^%DT S %XQB=Y S:$D(X1)#2 %XQX1=X1 S:$D(X2)#2 %XQX2=X2 S X1=%XQB,X2=7 D C^%DTC S %XQB1=X S:$D(%XQX1) X1=%XQX1 S:$D(%XQX2) X2=%XQX2 K %XQX1,%XQX2
S X="" F %XQJ=0:0 Q:X'=""!('$D(%XQB)) S X=%XQB K %XQB D ENT2 I X>%XQB1 S X="" ;W !,$C(7),"ALL TIMES ARE PROHIBITED FOR THIS OPTION -- CAN'T BE DONE",$C(7),!
K %XQB,%XQB1,%XQJ
Q
CHKQUE ;Entry point to check whether queueing is required, and if so the
;first available time for this option.
; ENTRY IS WITH THE OPTION NUMBER IN +XQY
;
Q:'$D(XQY) S X="N",%DT="T" D ^%DT S X=Y,%XQOP=3.92 D:$D(^DIC(19,+XQY,3.92)) ENT2 I X'="" S XQUEFLG=0 K %XQOP Q
D NENT S XQUEFLG=1
Q
XQ92 ;SEA/JLI - DATE/TIME FOR PROHIBITED TIME/DAY ;7/23/91 14:11 ;4/6/92 1:02 PM [ 04/02/2003 8:29 AM ]
+1 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
+2 ;;8.0;KERNEL;;Jul 10, 1995
+3 ; ENTRY IS WITH DATE TIME IN FILEMANAGER FORMAT IN VARIABLE X
+4 ; INTERNAL ENTRY NUMBER OF OPTION IN +XQY
+5 ;
+6 ; ON RETURN X IS UNCHANGED IF NOT WITHIN A PROHIBITED TIME,
+7 ; NULL IF WITHIN A PROHIBITED TIME.
+8 ;
ENTRY ; Check that input values are legitimate
+1 NEW %,%D,%H,%M,%T,%XQ1,%XQ2,%XQ3,%XQA,%XQB,%XQK,%XQK0,%XQK1,%XQK2
+2 NEW %XQOP,%XQX,%Y,XQUEFLG
+3 SET %XQOP=3.91
DO ENT2
IF X'=""
SET %XQOP=3.92
DO ENT2
+4 KILL %XQOP,XQUEFLG
+5 QUIT
ENT2 ;
+1 IF '$DATA(X)!'$DATA(XQY)
QUIT
IF +X'>0
QUIT
IF '$DATA(^DIC(19,+XQY,0))
QUIT
+2 KILL %XQX
IF '$DATA(^DIC(19,+XQY,%XQOP))
GOTO CHK0
+3 ; Check for data in multiple DAY/TIMES field
+4 SET %XQA=0
FOR %XQI=1:1
SET %XQA=$ORDER(^DIC(19,+XQY,%XQOP,%XQA))
IF %XQA'>0
QUIT
SET %XQX(%XQI)=$PIECE(^(%XQA,0),U,1)_$PIECE(^(0),U,2)
+5 KILL %XQA,%XQI
IF $DATA(%XQX)
GOTO CHKIT
+6 ;
CHK0 ; Check zero node for old prohibited time
+1 IF %XQOP=3.92
QUIT
SET %XQX(1)=$PIECE(^DIC(19,+XQY,0),U,9)
IF '$LENGTH(%XQX(1))
KILL %XQX
QUIT
CHKIT ; Check for time within prohibited period
+1 SET %XQA="MO,TU,WE,TH,FR,SA,SU,MO,TU,WE,TH,FR,SA,"
+2 FOR %XQI=0:0
SET %XQI=$ORDER(%XQX(%XQI))
IF %XQI'>0
QUIT
DO CHKONE
+3 ; **** At this point set X to NULL if within a prohibited period.
IF '$DATA(%XQX)
SET X=""
+4 ;K %XQI,%XQX,%XQA
+5 QUIT
CHKONE ; Check for within prohibited period, if so KILL %XQX
+1 SET %XQ1=+$PIECE(%XQX(%XQI),"-",1)
SET %XQ2=+$EXTRACT($PIECE(%XQX(%XQI),"-",2),1,4)
SET %XQ3=+$EXTRACT($PIECE(X,".",2)_"0000",1,4)
+2 ; Time is outside specified range
IF %XQ1>%XQ3!(%XQ3>%XQ2)
QUIT
+3 ; Time is within range, what about day of week
+4 SET %XQ3=(%XQ2+1)#100
SET %XQB=%XQ2\100
SET %XQK1=""
IF %XQB>23
SET %XQB=0
SET %XQK1=1
IF %XQ3>59
SET %XQB=%XQB+1
SET %XQ3=0
SET %XQB=($PIECE(X,".",1)+%XQK1)_"."_$SELECT(%XQB>9:%XQB,1:"0"_%XQB)_$SELECT(%XQ3>9:%XQ3,1:"0"_%XQ3)
+5 SET %XQ3=$EXTRACT(%XQX(%XQI),10,100)
IF %XQ3=""
SET %XQ3="MO-FR"
+6 FOR %XQK=0:0
SET %XQK1=$FIND(%XQ3,"-")-3
IF %XQK1'>0
QUIT
SET %XQK2=%XQK1+4
SET %XQK0=$EXTRACT(%XQA,$FIND(%XQA,$EXTRACT(%XQ3,%XQK1,%XQK1+1))-2,100)
SET %XQK0=$EXTRACT(%XQK0,1,$FIND(%XQK0,$EXTRACT(%XQ3,%XQK2-1,%XQK2))-1)
SET %XQ3=$EXTRACT(%XQ3,1,%XQK1-1)_%XQK0_$EXTRACT(%XQ3,%XQK2+1,100)
+7 ; Holiday, set day of week to Sunday
KILL %XQK,%XQK0,%XQK1,%XQK2
SET %XQ1=%XQ3
IF $DATA(^HOLIDAY($PIECE(X,".",1),0))
SET %XQ3="SU"
+8 IF '$TEST
SET %XQ3=X
DO DOW^%DTC
SET X=%XQ3
SET %XQ3=$PIECE("SU^MO^TU^WE^TH^FR^SA",U,Y+1)
+9 ; Only a specific day, either good or bad
IF %XQ1[%XQ3
KILL %XQX
+10 QUIT
+11 ;
XQO ; Entry from checking via menu mapping X=date/time, XQY=OPTION, XQZ=string
+1 ; of prohibited times/dates, joined by semicolons.
+2 KILL %XQX
FOR %XQI=1:1
SET %XQ1=$PIECE(XQZ,";",%XQI)
IF %XQ1=""
QUIT
SET %XQX(%XQI)=%XQ1
+3 IF $DATA(%XQX)
DO CHKIT
+4 KILL %XQ1,%XQ2,%XQ3,%XQA,%XQB,%XQI,%XQJ,%XQX
+5 QUIT
+6 ;
NEXT ;Find next time which is NOT prohibited from current date/time
+1 ; Entry is with +Y equal to the option number
+2 ; Return is with the next non-prohibited date/time in X
+3 IF $GET(Y)>0
NEW XQY
SET XQY=+Y
+4 SET %XQOP=$SELECT($DATA(^DIC(19,+XQY,3.91)):3.91,$DATA(^(3.92)):3.92,1:3.91)
NENT ;
+1 SET X="N"
SET %DT="T"
DO ^%DT
SET %XQB=Y
IF $DATA(X1)#2
SET %XQX1=X1
IF $DATA(X2)#2
SET %XQX2=X2
SET X1=%XQB
SET X2=7
DO C^%DTC
SET %XQB1=X
IF $DATA(%XQX1)
SET X1=%XQX1
IF $DATA(%XQX2)
SET X2=%XQX2
KILL %XQX1,%XQX2
+2 ;W !,$C(7),"ALL TIMES ARE PROHIBITED FOR THIS OPTION -- CAN'T BE DONE",$C(7),!
SET X=""
FOR %XQJ=0:0
IF X'=""!('$DATA(%XQB))
QUIT
SET X=%XQB
KILL %XQB
DO ENT2
IF X>%XQB1
SET X=""
+3 KILL %XQB,%XQB1,%XQJ
+4 QUIT
CHKQUE ;Entry point to check whether queueing is required, and if so the
+1 ;first available time for this option.
+2 ; ENTRY IS WITH THE OPTION NUMBER IN +XQY
+3 ;
+4 IF '$DATA(XQY)
QUIT
SET X="N"
SET %DT="T"
DO ^%DT
SET X=Y
SET %XQOP=3.92
IF $DATA(^DIC(19,+XQY,3.92))
DO ENT2
IF X'=""
SET XQUEFLG=0
KILL %XQOP
QUIT
+5 DO NENT
SET XQUEFLG=1
+6 QUIT
