SDB0.m

SDB0 ;FLA/RF,BSN/GRR,ALB/LDB - PATTERN VALIDATION FOR CLINIC; 11 FEB 88@1200

 ;;5.3;Scheduling;;Aug 13, 1993

EN1 S SLT=+SL,HSI=SI

 S:SI=1 SI=4,HSI=1 S:SI=2 SI=4,HSI=2

 W !!?37,$P("SUN^MON^TUES^WEDNES^THURS^FRI^SATUR",U,DOW+1),"DAY",! S (STIME,LT)=STARTDAY*100,CNT=0,D0=SD

G2 R !!?2,"TIME: ",X:DTIME G:X="" G5 G:X["^"&('CNT) G1^SDB I X'?4N1"-"4N W "  [ LIKE 0800-1200 ]" G G2

 S T1=$P(X,"-",1),T2=$P(X,"-",2)

 S SD1=$E(T1,3,4) I SD1>59!(T1>2400) D WMIL G G2

 I SD1\5*5'=+SD1 D W5 G G2

 S SD1=$E(T2,3,4) I SD1>59!(T2>2400) D WMIL G G2

 I SD1\5*5'=+SD1 D W5 G G2

 I T1<STIME W "   [ CANNOT BE EARLIER THAN CLINIC START TIME ]" G G2

 I T1<LT W "   [ MUST BEGIN AFTER LAST ENDING TIME ]" G G2

 I T2'>T1 W "   [ MUST END AFTER BEGIN TIME ]" G G2

 S H1=$E(T1,1,2),H2=$E(T2,1,2),M1=$E(T1,3,4),M2=$E(T2,3,4) F SDCL="M1","M2" S:@SDCL=0 @SDCL=60

 S:M2=60 H2=H2-1 S:M1=60 H1=H1-1 S SD1=M2-M1+((H2-H1)*60),SDL=SD1\SLT I SDL*SLT'=+SD1 W "   [ TIME SPAN ENTERED NOT CONSISTENT WITH ",SLT," MIN APPT LENGTH ]" G G2

 K SD1

G3 R "   NO. SLOTS: 1//  ",NSL:DTIME S:NSL="" NSL=1 G:NSL["^" G2 I NSL'?1N.N W *7," ??" G G3

 S LT=T2,H1=$E(T1,1,2),H2=$E(T2,1,2),M1=$E(T1,3,4),M2=$E(T2,3,4)

 S M2=M2-SLT

G3A I M2<0 S M2=M2+60,H2=H2-1 G G3A

 S:M2?1N M2="0"_M2 S:H2?1N H2="0"_H2

G4 S CNT=CNT+1,^SC(DA,"T",D0,2,CNT,0)=H1_M1_"^"_NSL

 S M1=M1+SLT

G4A I M1>59 S M1=M1-60,H1=H1+1 G G4A

 S:M1?1N M1="0"_M1 S:H1?1N H1="0"_H1

 I (H1_M1)>(H2_M2) G G2

 G G4

G5 G:'CNT DEL1^SDB1:'$D(SDREACT),DEL1^SDB1:'$D(SDTOP)&$D(SDREACT)&'CNT,C^SDB S ^SC(DA,"T",D0,0)=D0,^SC(DA,"T",D0,2,0)="^44.004A^"_CNT_"^"_CNT

 S X=^SC(DA,"T",0),^(0)="^44.002D^"_D0_"^"_($P(X,"^",4)+1)

 S DH=SL*SI\60

 F ZDX=CNT:0 S ZDX=$N(^SC(DA,"T",D0,2,ZDX)) Q:ZDX<0  K ^SC(DA,"T",D0,2,ZDX)

 F X=0:0 S X=$N(^SC(DA,"T",D0,2,X)) Q:X'>0  S Y=^(X,0) F D=1:1:DH S Y(Y#100*SI\60+(Y\100*SI)-(STARTDAY*SI)+D)=$S($P(Y,U,2):$E("123456789jklmnopqrstuvwxyz",$P(Y,U,2)),1:0)

 S (DH,DO,X)="" I $D(Y)=1 W *7,!,"DELETE " S SDEL=1 G D^SDB1

 I $D(HSI) I HSI=1!(HSI=2) D CKSI1

 F Y=1:1 S DH=$D(Y(Y)),X=X_$S('DH&DO:"]",'DO&DH:"[",Y#SI=1:"|",1:" ")_$S(DH:Y(Y),1:" "),DO=DH I 'DH,$N(Y(Y))<0 Q

 K Y W !,X,!,"...PATTERN " I SI+SI+$L(X)>80 W *7,"TOO WIDE TO FIT ON 80-CHAR SCREEN!" K ^SC(DA,"T",D0) S CNT=0,LT=STIME,SDEL=0 G G2

 W "OK FOR " G D^SDB1

CKSI1 F SDJJ=$N(Y(-1)):$S(HSI=1:4,1:2) Q:SDJJ>41  S:$D(Y(SDJJ)) HY(SDJJ)="" I '$D(Y(SDJJ)) Q:$N(Y(SDJJ))'>0  S SDJJ=$N(Y(SDJJ-1))-$S(HSI=1:4,1:2)

 F HHY=0:0 S HHY=$N(Y(HHY)) Q:HHY<0  I '$D(HY(HHY)) K Y(HHY)

 Q

W5 W "   [ MUST SCHEDULE APPTS ON 5 MIN BOUNDARIES ]" Q

WMIL W "   [ MUST ENTER VALID MILITARY TIME FORMATS ]" Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SDB0   2611     printed  Apr 09, 2024@21:42:36                                                                                                                                                                                                        Page 2

SDB0      ;FLA/RF,BSN/GRR,ALB/LDB - PATTERN VALIDATION FOR CLINIC; 11 FEB 88@1200

 +1       ;;5.3;Scheduling;;Aug 13, 1993

EN1        SET SLT=+SL

           SET HSI=SI

 +1        if SI=1

               SET SI=4

               SET HSI=1

           if SI=2

               SET SI=4

               SET HSI=2

 +2        WRITE !!?37,$PIECE("SUN^MON^TUES^WEDNES^THURS^FRI^SATUR",U,DOW+1),"DAY",!

           SET (STIME,LT)=STARTDAY*100

           SET CNT=0

           SET D0=SD

G2         READ !!?2,"TIME: ",X:DTIME

           if X=""

               GOTO G5

           if X["^"&('CNT)

               GOTO G1^SDB

           IF X'?4N1"-"4N

               WRITE "  [ LIKE 0800-1200 ]"

               GOTO G2

 +1        SET T1=$PIECE(X,"-",1)

           SET T2=$PIECE(X,"-",2)

 +2        SET SD1=$EXTRACT(T1,3,4)

           IF SD1>59!(T1>2400)

               DO WMIL

               GOTO G2

 +3        IF SD1\5*5'=+SD1

               DO W5

               GOTO G2

 +4        SET SD1=$EXTRACT(T2,3,4)

           IF SD1>59!(T2>2400)

               DO WMIL

               GOTO G2

 +5        IF SD1\5*5'=+SD1

               DO W5

               GOTO G2

 +6        IF T1<STIME

               WRITE "   [ CANNOT BE EARLIER THAN CLINIC START TIME ]"

               GOTO G2

 +7        IF T1<LT

               WRITE "   [ MUST BEGIN AFTER LAST ENDING TIME ]"

               GOTO G2

 +8        IF T2'>T1

               WRITE "   [ MUST END AFTER BEGIN TIME ]"

               GOTO G2

 +9        SET H1=$EXTRACT(T1,1,2)

           SET H2=$EXTRACT(T2,1,2)

           SET M1=$EXTRACT(T1,3,4)

           SET M2=$EXTRACT(T2,3,4)

           FOR SDCL="M1","M2"

               if @SDCL=0

                   SET @SDCL=60

 +10       if M2=60

               SET H2=H2-1

           if M1=60

               SET H1=H1-1

           SET SD1=M2-M1+((H2-H1)*60)

           SET SDL=SD1\SLT

           IF SDL*SLT'=+SD1

               WRITE "   [ TIME SPAN ENTERED NOT CONSISTENT WITH ",SLT," MIN APPT LENGTH ]"

               GOTO G2

 +11       KILL SD1

G3         READ "   NO. SLOTS: 1//  ",NSL:DTIME

           if NSL=""

               SET NSL=1

           if NSL["^"

               GOTO G2

           IF NSL'?1N.N

               WRITE *7," ??"

               GOTO G3

 +1        SET LT=T2

           SET H1=$EXTRACT(T1,1,2)

           SET H2=$EXTRACT(T2,1,2)

           SET M1=$EXTRACT(T1,3,4)

           SET M2=$EXTRACT(T2,3,4)

 +2        SET M2=M2-SLT

G3A        IF M2<0

               SET M2=M2+60

               SET H2=H2-1

               GOTO G3A

 +1        if M2?1N

               SET M2="0"_M2

           if H2?1N

               SET H2="0"_H2

G4         SET CNT=CNT+1

           SET ^SC(DA,"T",D0,2,CNT,0)=H1_M1_"^"_NSL

 +1        SET M1=M1+SLT

G4A        IF M1>59

               SET M1=M1-60

               SET H1=H1+1

               GOTO G4A

 +1        if M1?1N

               SET M1="0"_M1

           if H1?1N

               SET H1="0"_H1

 +2        IF (H1_M1)>(H2_M2)

               GOTO G2

 +3        GOTO G4

G5         if 'CNT

               if '$DATA(SDREACT)

                   GOTO DEL1^SDB1

               if '$DATA(SDTOP)&$DATA(SDREACT)&'CNT

                   GOTO DEL1^SDB1

               GOTO C^SDB

           SET ^SC(DA,"T",D0,0)=D0

           SET ^SC(DA,"T",D0,2,0)="^44.004A^"_CNT_"^"_CNT

 +1        SET X=^SC(DA,"T",0)

           SET ^(0)="^44.002D^"_D0_"^"_($PIECE(X,"^",4)+1)

 +2        SET DH=SL*SI\60

 +3        FOR ZDX=CNT:0