source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XQ92.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.3 KB
Line 
1XQ92 ;SEA/JLI - DATE/TIME FOR PROHIBITED TIME/DAY ;7/23/91 14:11 ;4/6/92 1:02 PM
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 ;
9ENTRY ; Check that input values are legitimate
10 N %,%D,%H,%M,%T,%XQ1,%XQ2,%XQ3,%XQA,%XQB,%XQK,%XQK0,%XQK1,%XQK2
11 N %XQOP,%XQX,%Y,XQUEFLG
12 S %XQOP=3.91 D ENT2 I X'="" S %XQOP=3.92 D ENT2
13 K %XQOP,XQUEFLG
14 Q
15ENT2 ;
16 Q:'$D(X)!'$D(XQY) Q:+X'>0 Q:'$D(^DIC(19,+XQY,0))
17 K %XQX G:'$D(^DIC(19,+XQY,%XQOP)) CHK0
18 ; Check for data in multiple DAY/TIMES field
19 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)
20 K %XQA,%XQI G:$D(%XQX) CHKIT
21 ;
22CHK0 ; Check zero node for old prohibited time
23 Q:%XQOP=3.92 S %XQX(1)=$P(^DIC(19,+XQY,0),U,9) I '$L(%XQX(1)) K %XQX Q
24CHKIT ; Check for time within prohibited period
25 S %XQA="MO,TU,WE,TH,FR,SA,SU,MO,TU,WE,TH,FR,SA,"
26 F %XQI=0:0 S %XQI=$O(%XQX(%XQI)) Q:%XQI'>0 D CHKONE
27 I '$D(%XQX) S X="" ; **** At this point set X to NULL if within a prohibited period.
28 ;K %XQI,%XQX,%XQA
29 Q
30CHKONE ; Check for within prohibited period, if so KILL %XQX
31 S %XQ1=+$P(%XQX(%XQI),"-",1),%XQ2=+$E($P(%XQX(%XQI),"-",2),1,4),%XQ3=+$E($P(X,".",2)_"0000",1,4)
32 I %XQ1>%XQ3!(%XQ3>%XQ2) Q ; Time is outside specified range
33 ; Time is within range, what about day of week
34 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)
35 S %XQ3=$E(%XQX(%XQI),10,100) I %XQ3="" S %XQ3="MO-FR"
36 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)
37 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
38 E S %XQ3=X D DOW^%DTC S X=%XQ3,%XQ3=$P("SU^MO^TU^WE^TH^FR^SA",U,Y+1)
39 I %XQ1[%XQ3 K %XQX ; Only a specific day, either good or bad
40 Q
41 ;
42XQO ; Entry from checking via menu mapping X=date/time, XQY=OPTION, XQZ=string
43 ; of prohibited times/dates, joined by semicolons.
44 K %XQX F %XQI=1:1 S %XQ1=$P(XQZ,";",%XQI) Q:%XQ1="" S %XQX(%XQI)=%XQ1
45 I $D(%XQX) D CHKIT
46 K %XQ1,%XQ2,%XQ3,%XQA,%XQB,%XQI,%XQJ,%XQX
47 Q
48 ;
49NEXT ;Find next time which is NOT prohibited from current date/time
50 ; Entry is with +Y equal to the option number
51 ; Return is with the next non-prohibited date/time in X
52 I $G(Y)>0 N XQY S XQY=+Y
53 S %XQOP=$S($D(^DIC(19,+XQY,3.91)):3.91,$D(^(3.92)):3.92,1:3.91)
54NENT ;
55 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
56 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),!
57 K %XQB,%XQB1,%XQJ
58 Q
59CHKQUE ;Entry point to check whether queueing is required, and if so the
60 ;first available time for this option.
61 ; ENTRY IS WITH THE OPTION NUMBER IN +XQY
62 ;
63 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
64 D NENT S XQUEFLG=1
65 Q
Note: See TracBrowser for help on using the repository browser.