| 1 | SDMULT1 ;ALB/TMP - MAKE MULTI-CLINIC APPOINTMENTS ; 18 APR 86
|
|---|
| 2 | ;;5.3;Scheduling;**32,41,167**;AUG 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | FND I $D(SDNEXT) S SDPCM1=""
|
|---|
| 5 | I $D(SDNEXT),$G(SDPCMM(SC))>2 K SDPCM1 G ACT
|
|---|
| 6 | I $D(SDNEXT),+$G(SDPCMM(SC))<1 W @IOF
|
|---|
| 7 | I '$D(SDNEXT) W @IOF
|
|---|
| 8 | W !?25,"DATE: " S X=SDAPP D DOW^SDM0 W "(",$P($P($T(DAY),";",3),"^",Y+2),"DAY) " S Y=SDAPP D DT^DIQ W ! F G1=0:0 S G1=$O(SDC(G1)) Q:G1'>0 S SC=+SDC(G1) D S2 S X=SDAPP,SCPCMM(SC)=0 D PROC
|
|---|
| 9 | ACT I '$D(SDPCMM) W:'$D(SDNEXT) ! W !,"ENTER: ",!,?3,"'^' - EXIT " W:'$D(SDNEXT) "'B' - BOOK " W "'C' - CONTINUE SEARCH or 'R' - REDISPLAY: CONTINUE// " R X:DTIME G:X["^" END^SDMULT0 S X=$E(X) I X?1"?"!("BCR"'[X) D H1 G ACT
|
|---|
| 10 | I '$D(SDPCMM),$D(SDNEXT) S SDNEXT=1
|
|---|
| 11 | I $D(SDPCM1) S X="C"
|
|---|
| 12 | I X["C"!(X']"") S FND=0 F I=1:1:SDCT S SDDT(I)=0
|
|---|
| 13 | I S X1=SDSTRTDT,X2=1 D C^%DTC S SDSTRTDT=X G LOOKA^SDMULT0
|
|---|
| 14 | I X["R" G FND
|
|---|
| 15 | I X["B",'$D(SDNEXT) G BOOK
|
|---|
| 16 | I '$D(SDPCMM) K SDPCM1 D H1 G ACT
|
|---|
| 17 | PROC I $D(SDNEXT) S SDPCMM(SC)=$G(SDPCMM(SC))+1
|
|---|
| 18 | I $D(SDNEXT),$G(SDPCMM(SC))>3 K SDPCM1 Q
|
|---|
| 19 | S SDV="",$P(SDV," ",SI+SI-5)="" W !,"CLINIC: ",$P(SDC1(SC),"^",1),?50,"(",$P(SDC1(SC),"^",2)," MINUTES)",!,"-------" S LINE=" TIME"_SDV F Y=STARTDAY:1:65\(SI+SI)+STARTDAY S LINE=LINE_$E("|"_$S('Y:0,1:(Y-1#12+1))_" ",1,SI+SI)
|
|---|
| 20 | W !,$E(LINE,1,80) S LINE(G1)=$E(LINE,1,80)
|
|---|
| 21 | W !,$E(^SC(SC,"ST",SDAPP,1),1,80),! S LINE1(G1)=$E(^(1),1,80) Q
|
|---|
| 22 | H1 W !,"YOU MAY ENTER:",!,?10,"'^' TO EXIT" W:'$D(SDNEXT) !,?10,"'B' TO ENTER THE MAKE APPT ROUTINES AND BOOK THE APPOINTMENTS"
|
|---|
| 23 | W !,?10,"'C' TO LOOK FOR THE NEXT DATE ALL CLINICS HAVE AN AVAILABLE TIME SLOT",!,?10,"'R' TO REDISPLAY THIS SAME SCREEN" Q
|
|---|
| 24 | ;
|
|---|
| 25 | DAY ;;^SUN^MON^TUES^WEDNES^THURS^FRI^SATUR
|
|---|
| 26 | ;
|
|---|
| 27 | BOOK D STARS
|
|---|
| 28 | F G1=0:0 S G1=$O(SDC(G1)) Q:G1'>0 W !!,"Make appt in : ",$P(SDC(G1),"^",2),! S SC=+SDC(G1) D S2,S3,TM D:SDMADE MADE D:'SDMADE NOT
|
|---|
| 29 | K COLLAT G END^SDMULT0
|
|---|
| 30 | MADE W !!,$P(^SC(+SDC(G1),"S",SD,1,SDY,0),"^",2)," minute appointment made in ",$P(SDC(G1),"^",2),! D STARS
|
|---|
| 31 | Q
|
|---|
| 32 | NOT W !!,"No appt made in ",$P(SDC1(SC),"^"),! D STARS
|
|---|
| 33 | Q
|
|---|
| 34 | STARS S SD0="",$P(SD0,"*",81)="" W !,SD0 K SD0 Q
|
|---|
| 35 | TM S SDMADE=0 R !!,"SCHEDULE TIME: ",X:DTIME Q:"^"[X!'($T) I X?.E1"?"!(X'?1N.N) W !,"Enter the appointment time for this clinic" G TM
|
|---|
| 36 | S X=$E(SDAPP,4,7)_$E(SDAPP,2,3)_"@"_X,%DT="TE" D ^%DT I Y<0 W *7," WHEN ??" G TM
|
|---|
| 37 | K %DT S X=Y#1,Y=+Y I $D(^DPT(DFN,"S",Y,0)),$P(^(0),"^",2)'["C" S Y1=+^(0),Y1=$P(^SC(+Y1,0),"^") W !,*7,"Patient already has an appointment in ",Y1," at that time" K Y1 G TM
|
|---|
| 38 | S:$P(SL,"^",2)]"" $P(SL,"^")=$P(SDC1(SC),"^",2) S SDMLT=1 K SDAPTYP D EN1^SDM1
|
|---|
| 39 | G:'SDMADE!(SDMADE=2) TM Q
|
|---|
| 40 | S2 S SL=^SC(SC,"SL"),X=$P(SL,"^",3),STARTDAY=$S($L(X):X,1:8),X=$P(SL,"^",6),SI=$S(X="":4,X<3:4,X:X,1:4) Q
|
|---|
| 41 | S3 W !,LINE(G1),!,LINE1(G1)
|
|---|
| 42 | S SB=STARTDAY-1/100,X=$P(SL,U,6),HSI=$S(X=1:X,X:X,1:4),STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz",SDDIF=$S(HSI<3:8/HSI,1:2),SM=0
|
|---|
| 43 | K MXOK S SD=SDAPP,(CCX,CCXN,DP)=""
|
|---|
| 44 | Q
|
|---|
