| [613] | 1 | SDB0 ;FLA/RF,BSN/GRR,ALB/LDB - PATTERN VALIDATION FOR CLINIC; 11 FEB 88@1200
|
|---|
| 2 | ;;5.3;Scheduling;;Aug 13, 1993
|
|---|
| 3 | EN1 S SLT=+SL,HSI=SI
|
|---|
| 4 | S:SI=1 SI=4,HSI=1 S:SI=2 SI=4,HSI=2
|
|---|
| 5 | W !!?37,$P("SUN^MON^TUES^WEDNES^THURS^FRI^SATUR",U,DOW+1),"DAY",! S (STIME,LT)=STARTDAY*100,CNT=0,D0=SD
|
|---|
| 6 | G2 R !!?2,"TIME: ",X:DTIME G:X="" G5 G:X["^"&('CNT) G1^SDB I X'?4N1"-"4N W " [ LIKE 0800-1200 ]" G G2
|
|---|
| 7 | S T1=$P(X,"-",1),T2=$P(X,"-",2)
|
|---|
| 8 | S SD1=$E(T1,3,4) I SD1>59!(T1>2400) D WMIL G G2
|
|---|
| 9 | I SD1\5*5'=+SD1 D W5 G G2
|
|---|
| 10 | S SD1=$E(T2,3,4) I SD1>59!(T2>2400) D WMIL G G2
|
|---|
| 11 | I SD1\5*5'=+SD1 D W5 G G2
|
|---|
| 12 | I T1<STIME W " [ CANNOT BE EARLIER THAN CLINIC START TIME ]" G G2
|
|---|
| 13 | I T1<LT W " [ MUST BEGIN AFTER LAST ENDING TIME ]" G G2
|
|---|
| 14 | I T2'>T1 W " [ MUST END AFTER BEGIN TIME ]" G G2
|
|---|
| 15 | 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
|
|---|
| 16 | 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
|
|---|
| 17 | K SD1
|
|---|
| 18 | G3 R " NO. SLOTS: 1// ",NSL:DTIME S:NSL="" NSL=1 G:NSL["^" G2 I NSL'?1N.N W *7," ??" G G3
|
|---|
| 19 | S LT=T2,H1=$E(T1,1,2),H2=$E(T2,1,2),M1=$E(T1,3,4),M2=$E(T2,3,4)
|
|---|
| 20 | S M2=M2-SLT
|
|---|
| 21 | G3A I M2<0 S M2=M2+60,H2=H2-1 G G3A
|
|---|
| 22 | S:M2?1N M2="0"_M2 S:H2?1N H2="0"_H2
|
|---|
| 23 | G4 S CNT=CNT+1,^SC(DA,"T",D0,2,CNT,0)=H1_M1_"^"_NSL
|
|---|
| 24 | S M1=M1+SLT
|
|---|
| 25 | G4A I M1>59 S M1=M1-60,H1=H1+1 G G4A
|
|---|
| 26 | S:M1?1N M1="0"_M1 S:H1?1N H1="0"_H1
|
|---|
| 27 | I (H1_M1)>(H2_M2) G G2
|
|---|
| 28 | G G4
|
|---|
| 29 | 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
|
|---|
| 30 | S X=^SC(DA,"T",0),^(0)="^44.002D^"_D0_"^"_($P(X,"^",4)+1)
|
|---|
| 31 | S DH=SL*SI\60
|
|---|
| 32 | F ZDX=CNT:0 S ZDX=$N(^SC(DA,"T",D0,2,ZDX)) Q:ZDX<0 K ^SC(DA,"T",D0,2,ZDX)
|
|---|
| 33 | 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)
|
|---|
| 34 | S (DH,DO,X)="" I $D(Y)=1 W *7,!,"DELETE " S SDEL=1 G D^SDB1
|
|---|
| 35 | I $D(HSI) I HSI=1!(HSI=2) D CKSI1
|
|---|
| 36 | 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
|
|---|
| 37 | 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
|
|---|
| 38 | W "OK FOR " G D^SDB1
|
|---|
| 39 | 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)
|
|---|
| 40 | F HHY=0:0 S HHY=$N(Y(HHY)) Q:HHY<0 I '$D(HY(HHY)) K Y(HHY)
|
|---|
| 41 | Q
|
|---|
| 42 | W5 W " [ MUST SCHEDULE APPTS ON 5 MIN BOUNDARIES ]" Q
|
|---|
| 43 | WMIL W " [ MUST ENTER VALID MILITARY TIME FORMATS ]" Q
|
|---|
