- SDMULT1 ;ALB/TMP - MAKE MULTI-CLINIC APPOINTMENTS ; 18 APR 86
- ;;5.3;Scheduling;**32,41,167,1015**;AUG 13, 1993;Build 21
- ;
- FND I $D(SDNEXT) S SDPCM1=""
- I $D(SDNEXT),$G(SDPCMM(SC))>2 K SDPCM1 G ACT
- I $D(SDNEXT),+$G(SDPCMM(SC))<1 W @IOF
- I '$D(SDNEXT) W @IOF
- 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
- 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
- I '$D(SDPCMM),$D(SDNEXT) S SDNEXT=1
- I $D(SDPCM1) S X="C"
- I X["C"!(X']"") S FND=0 F I=1:1:SDCT S SDDT(I)=0
- I S X1=SDSTRTDT,X2=1 D C^%DTC S SDSTRTDT=X G LOOKA^SDMULT0
- I X["R" G FND
- I X["B",'$D(SDNEXT) G BOOK
- I '$D(SDPCMM) K SDPCM1 D H1 G ACT
- PROC I $D(SDNEXT) S SDPCMM(SC)=$G(SDPCMM(SC))+1
- I $D(SDNEXT),$G(SDPCMM(SC))>3 K SDPCM1 Q
- 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)
- W !,$E(LINE,1,80) S LINE(G1)=$E(LINE,1,80)
- W !,$E(^SC(SC,"ST",SDAPP,1),1,80),! S LINE1(G1)=$E(^(1),1,80) Q
- H1 W !,"YOU MAY ENTER:",!,?10,"'^' TO EXIT" W:'$D(SDNEXT) !,?10,"'B' TO ENTER THE MAKE APPT ROUTINES AND BOOK THE APPOINTMENTS"
- W !,?10,"'C' TO LOOK FOR THE NEXT DATE ALL CLINICS HAVE AN AVAILABLE TIME SLOT",!,?10,"'R' TO REDISPLAY THIS SAME SCREEN" Q
- ;
- DAY ;;^SUN^MON^TUES^WEDNES^THURS^FRI^SATUR
- ;
- BOOK D STARS
- 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
- K COLLAT G END^SDMULT0
- MADE W !!,$P(^SC(+SDC(G1),"S",SD,1,SDY,0),"^",2)," minute appointment made in ",$P(SDC(G1),"^",2),! D STARS
- Q
- NOT W !!,"No appt made in ",$P(SDC1(SC),"^"),! D STARS
- Q
- STARS S SD0="",$P(SD0,"*",81)="" W !,SD0 K SD0 Q
- 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
- S X=$E(SDAPP,4,7)_$E(SDAPP,2,3)_"@"_X,%DT="TE" D ^%DT I Y<0 W *7," WHEN ??" G TM
- 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
- S:$P(SL,"^",2)]"" $P(SL,"^")=$P(SDC1(SC),"^",2) S SDMLT=1 K SDAPTYP D EN1^SDM1
- G:'SDMADE!(SDMADE=2) TM Q
- 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
- S3 W !,LINE(G1),!,LINE1(G1)
- 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
- K MXOK S SD=SDAPP,(CCX,CCXN,DP)=""
- Q
- SDMULT1 ;ALB/TMP - MAKE MULTI-CLINIC APPOINTMENTS ; 18 APR 86
- +1 ;;5.3;Scheduling;**32,41,167,1015**;AUG 13, 1993;Build 21
- +2 ;
- FND IF $DATA(SDNEXT)
- SET SDPCM1=""
- +1 IF $DATA(SDNEXT)
- IF $GET(SDPCMM(SC))>2
- KILL SDPCM1
- GOTO ACT
- +2 IF $DATA(SDNEXT)
- IF +$GET(SDPCMM(SC))<1
- WRITE @IOF
- +3 IF '$DATA(SDNEXT)
- WRITE @IOF
- +4 WRITE !?25,"DATE: "
- SET X=SDAPP
- DO DOW^SDM0
- WRITE "(",$PIECE($PIECE($TEXT(DAY),";",3),"^",Y+2),"DAY) "
- SET Y=SDAPP
- DO DT^DIQ
- WRITE !
- FOR G1=0:0
- SET G1=$ORDER(SDC(G1))
- IF G1'>0
- QUIT
- SET SC=+SDC(G1)
- DO S2
- SET X=SDAPP
- SET SCPCMM(SC)=0
- DO PROC
- ACT IF '$DATA(SDPCMM)
- IF '$DATA(SDNEXT)
- WRITE !
- WRITE !,"ENTER: ",!,?3,"'^' - EXIT "
- IF '$DATA(SDNEXT)
- WRITE "'B' - BOOK "
- WRITE "'C' - CONTINUE SEARCH or 'R' - REDISPLAY: CONTINUE// "
- READ X:DTIME
- IF X["^"
- GOTO END^SDMULT0
- SET X=$EXTRACT(X)
- IF X?1"?"!("BCR"'[X)
- DO H1
- GOTO ACT
- +1 IF '$DATA(SDPCMM)
- IF $DATA(SDNEXT)
- SET SDNEXT=1
- +2 IF $DATA(SDPCM1)
- SET X="C"
- +3 IF X["C"!(X']"")
- SET FND=0
- FOR I=1:1:SDCT
- SET SDDT(I)=0
- +4 IF $TEST
- SET X1=SDSTRTDT
- SET X2=1
- DO C^%DTC
- SET SDSTRTDT=X
- GOTO LOOKA^SDMULT0
- +5 IF X["R"
- GOTO FND
- +6 IF X["B"
- IF '$DATA(SDNEXT)
- GOTO BOOK
- +7 IF '$DATA(SDPCMM)
- KILL SDPCM1
- DO H1
- GOTO ACT
- PROC IF $DATA(SDNEXT)
- SET SDPCMM(SC)=$GET(SDPCMM(SC))+1
- +1 IF $DATA(SDNEXT)
- IF $GET(SDPCMM(SC))>3
- KILL SDPCM1
- QUIT
- +2 SET SDV=""
- SET $PIECE(SDV," ",SI+SI-5)=""
- WRITE !,"CLINIC: ",$PIECE(SDC1(SC),"^",1),?50,"(",$PIECE(SDC1(SC),"^",2)," MINUTES)",!,"-------"
- SET LINE=" TIME"_SDV
- FOR Y=STARTDAY:1:65\(SI+SI)+STARTDAY
- SET LINE=LINE_$EXTRACT("|"_$SELECT('Y:0,1:(Y-1#12+1))_" ",1,SI+SI)
- +3 WRITE !,$EXTRACT(LINE,1,80)
- SET LINE(G1)=$EXTRACT(LINE,1,80)
- +4 WRITE !,$EXTRACT(^SC(SC,"ST",SDAPP,1),1,80),!
- SET LINE1(G1)=$EXTRACT(^(1),1,80)
- QUIT
- H1 WRITE !,"YOU MAY ENTER:",!,?10,"'^' TO EXIT"
- IF '$DATA(SDNEXT)
- WRITE !,?10,"'B' TO ENTER THE MAKE APPT ROUTINES AND BOOK THE APPOINTMENTS"
- +1 WRITE !,?10,"'C' TO LOOK FOR THE NEXT DATE ALL CLINICS HAVE AN AVAILABLE TIME SLOT",!,?10,"'R' TO REDISPLAY THIS SAME SCREEN"
- QUIT
- +2 ;
- DAY ;;^SUN^MON^TUES^WEDNES^THURS^FRI^SATUR
- +1 ;
- BOOK DO STARS
- +1 FOR G1=0:0
- SET G1=$ORDER(SDC(G1))
- IF G1'>0
- QUIT
- WRITE !!,"Make appt in : ",$PIECE(SDC(G1),"^",2),!
- SET SC=+SDC(G1)
- DO S2
- DO S3
- DO TM
- IF SDMADE
- DO MADE
- IF 'SDMADE
- DO NOT
- +2 KILL COLLAT
- GOTO END^SDMULT0
- MADE WRITE !!,$PIECE(^SC(+SDC(G1),"S",SD,1,SDY,0),"^",2)," minute appointment made in ",$PIECE(SDC(G1),"^",2),!
- DO STARS
- +1 QUIT
- NOT WRITE !!,"No appt made in ",$PIECE(SDC1(SC),"^"),!
- DO STARS
- +1 QUIT
- STARS SET SD0=""
- SET $PIECE(SD0,"*",81)=""
- WRITE !,SD0
- KILL SD0
- QUIT
- TM SET SDMADE=0
- READ !!,"SCHEDULE TIME: ",X:DTIME
- IF "^"[X!'($TEST)
- QUIT
- IF X?.E1"?"!(X'?1N.N)
- WRITE !,"Enter the appointment time for this clinic"
- GOTO TM
- +1 SET X=$EXTRACT(SDAPP,4,7)_$EXTRACT(SDAPP,2,3)_"@"_X
- SET %DT="TE"
- DO ^%DT
- IF Y<0
- WRITE *7," WHEN ??"
- GOTO TM
- +2 KILL %DT
- SET X=Y#1
- SET Y=+Y
- IF $DATA(^DPT(DFN,"S",Y,0))
- IF $PIECE(^(0),"^",2)'["C"
- SET Y1=+^(0)
- SET Y1=$PIECE(^SC(+Y1,0),"^")
- WRITE !,*7,"Patient already has an appointment in ",Y1," at that time"
- KILL Y1
- GOTO TM
- +3 IF $PIECE(SL,"^",2)]""
- SET $PIECE(SL,"^")=$PIECE(SDC1(SC),"^",2)
- SET SDMLT=1
- KILL SDAPTYP
- DO EN1^SDM1
- +4 IF 'SDMADE!(SDMADE=2)
- GOTO TM
- QUIT
- S2 SET SL=^SC(SC,"SL")
- SET X=$PIECE(SL,"^",3)
- SET STARTDAY=$SELECT($LENGTH(X):X,1:8)
- SET X=$PIECE(SL,"^",6)
- SET SI=$SELECT(X="":4,X<3:4,X:X,1:4)
- QUIT
- S3 WRITE !,LINE(G1),!,LINE1(G1)
- +1 SET SB=STARTDAY-1/100
- SET X=$PIECE(SL,U,6)
- SET HSI=$SELECT(X=1:X,X:X,1:4)
- SET STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz"
- SET SDDIF=$SELECT(HSI<3:8/HSI,1:2)
- SET SM=0
- +2 KILL MXOK
- SET SD=SDAPP
- SET (CCX,CCXN,DP)=""
- +3 QUIT
