- XQ92 ;SEA/JLI - DATE/TIME FOR PROHIBITED TIME/DAY ;7/23/91 14:11 ;4/6/92 1:02 PM
- ;;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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQ92 3464 printed Feb 18, 2025@23:31:40 Page 2
- XQ92 ;SEA/JLI - DATE/TIME FOR PROHIBITED TIME/DAY ;7/23/91 14:11 ;4/6/92 1:02 PM
- +1 ;;8.0;KERNEL;;Jul 10, 1995
- +2 ; ENTRY IS WITH DATE TIME IN FILEMANAGER FORMAT IN VARIABLE X
- +3 ; INTERNAL ENTRY NUMBER OF OPTION IN +XQY
- +4 ;
- +5 ; ON RETURN X IS UNCHANGED IF NOT WITHIN A PROHIBITED TIME,
- +6 ; NULL IF WITHIN A PROHIBITED TIME.
- +7 ;
- 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