source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDMULT1.m@ 1141

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

initial load of WorldVistAEHR

File size: 2.8 KB
Line 
1SDMULT1 ;ALB/TMP - MAKE MULTI-CLINIC APPOINTMENTS ; 18 APR 86
2 ;;5.3;Scheduling;**32,41,167**;AUG 13, 1993
3 ;
4FND 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
9ACT 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
17PROC 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
22H1 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 ;
25DAY ;;^SUN^MON^TUES^WEDNES^THURS^FRI^SATUR
26 ;
27BOOK 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
30MADE W !!,$P(^SC(+SDC(G1),"S",SD,1,SDY,0),"^",2)," minute appointment made in ",$P(SDC(G1),"^",2),! D STARS
31 Q
32NOT W !!,"No appt made in ",$P(SDC1(SC),"^"),! D STARS
33 Q
34STARS S SD0="",$P(SD0,"*",81)="" W !,SD0 K SD0 Q
35TM 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
40S2 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
41S3 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
Note: See TracBrowser for help on using the repository browser.