| 1 | SDMM ;SF/GFT,MAN/GRR - MULTIPLE APPOINTMENTS ; 2/7/05 12:51pm ; Compiled September 25, 2006 13:33:14
|
|---|
| 2 | ;;5.3;Scheduling;**26,32,167,241,327,446**;Aug 13, 1993;Build 77
|
|---|
| 3 | N SDHX,SDAPDT S SDMM=1 D ^SDM K SDMM Q
|
|---|
| 4 | RDTY K ^TMP($J,"APPT"),^TMP($J,"SDAMA301") ;SD/327
|
|---|
| 5 | R !,"WANT TO MAKE DAILY OR WEEKLY APPOINTMENTS?: WEEKLY// ",SDTYP:DTIME Q:SDTYP["^"!('$T) S:SDTYP="" SDTYP="W" S SDTYP=$$UP^XLFSTR($E(SDTYP)) I "WD"'[SDTYP W !,"ENTER 'D' FOR DAILY OR PRESS RETURN" G RDTY
|
|---|
| 6 | RD22 I SDTYP["D" S %=2 W !,"WANT APPOINTMENTS MADE ON SATURDAYS AND SUNDAYS" D YN^DICN S SDWE=$S(%<0:"^",%=2:"N",%=1:"Y",1:"?") Q:SDWE["^" G:SDWE["?" HLP22
|
|---|
| 7 | ADT K SDERRFT S CCX=""
|
|---|
| 8 | S X=$G(SDSDATE) S:X SDHX=X\1 K SDSDATE
|
|---|
| 9 | W:X#1 !,"APPOINTMENT DATE/TIME REQUESTED: "
|
|---|
| 10 | I '(X#1) R !,"DATE/TIME: ",X:DTIME I "^"[X K X,SD Q
|
|---|
| 11 | I X="M"!(X="m") D MORDIS G ADT
|
|---|
| 12 | I X="D"!(X="d") S X=$$REDDT^SDM1() D:X>0 MORD2 W:X="" $C(7)," ??",! G ADT
|
|---|
| 13 | I X?1"?".E D HLP1 G ADT
|
|---|
| 14 | I X=" ",$G(SDAPDT) S Y=SDAPDT D AT^SDUTL W Y S Y=SDAPDT G OVR
|
|---|
| 15 | I $E($P(X,"@",2),1,4)?1.4"0" K %DT S X=$P(X,"@"),X=$S($L(X):X,1:"T"),%DT="XF" D ^%DT G ADT:Y'>0 S X1=Y,X2=-1 D C^%DTC S X=X_.24
|
|---|
| 16 | K %DT S %DT="TXEF" D ^%DT
|
|---|
| 17 | I $P(Y,".",2)=24 S X1=$P(Y,"."),X2=1 D C^%DTC S Y=X_".000001"
|
|---|
| 18 | S SDSOH=$S('$D(^SC(+SC,"SL")):0,$P(^("SL"),"^",8)']"":0,1:1)
|
|---|
| 19 | OVR S SDY1=$P(Y,".") I $D(^HOLIDAY(SDY1,0)),'SDSOH W *7,?50,$P(^(0),U,2),"??" G ADT
|
|---|
| 20 | I $D(SDINA),SDY1'<SDINA,$S('$D(SDRE):1,SDRE>SDY1!('SDRE):1,1:0) S SDY=Y,Y=SDINA D DTS^SDUTL W !,*7,"Clinic is scheduled to be inactivated on ",Y S Y=SDRE D:Y DTS^SDUTL W $S(SDRE:" and reactivated on "_Y,1:"") S Y=SDY K SDY G ADT
|
|---|
| 21 | I Y#1=0 G ADT
|
|---|
| 22 | D SDFT I $P(Y,".")'<SDEDT W !,*7,"EXCEEDS MAXIMUM DAYS FOR FUTURE APPOINTMENT!!",*7 G ADT
|
|---|
| 23 | LEN I $P(SL,U,2)]"" W !,"LENGTH OF APPOINTMENTS (IN MINUTES): ",+SL,"// " R S:DTIME I S]"" G:$L(S)>3 LEN Q:U[S S POP=0 D L^SDM1 G LEN:POP I S\5*5=S,S'>360,S'<5 S SL=S_U_$P(SL,U,2,99)
|
|---|
| 24 | S SDOT=Y#1,SDDAT=$P(Y,"."),X=Y D DOW^SDM0
|
|---|
| 25 | RDC W !,"FOR HOW MANY CONSECUTIVE ",$S(SDTYP["W":$P($T(DAY),"^",Y+2)_"DAY'S",1:"DAYS")," DO YOU WANT APPOINTMENTS SCHEDULED",!," AT " S X=SDOT D TM W X,"?: "
|
|---|
| 26 | R SDCN:DTIME G:SDCN=""!(SDCN="^") ADT G HLP:SDCN'?.N,HLP:SDCN<1,HLP:SDCN>60
|
|---|
| 27 | S Y=SDDAT_SDOT,SDMCNT=0,SDMADE=0
|
|---|
| 28 | OTHER R !," OTHER INFO: ",D:DTIME I D["^" W !,*7,"'^' not allowed - hit return if no 'OTHER INFO' is to be entered" G OTHER
|
|---|
| 29 | I $L(D)>150 D MSG G OTHER
|
|---|
| 30 | I D]"",D?."?"!(D'?.ANP) W " ENTER LAB, SCAN, ETC." G OTHER
|
|---|
| 31 | I $L(D)+$L(SDW)>250 D MSG G OTHER
|
|---|
| 32 | BEGIN S SDZM=1,SDZY=Y,SDX9=X,SDM9=D D SDMM^SDM1A K SDZM S Y=SDZY,X=SDX9,D=SDM9
|
|---|
| 33 | F SDZ=1:1:SDCN D MAKE^SDMM1 Q:$D(SDERRFT) D Q:POP
|
|---|
| 34 | .S:SDMADE SDMCNT=SDMCNT+1 I SDMADE,SDZ=1 S SDAPDT=SD
|
|---|
| 35 | .S SDMADE=0,POP=0 D GETNEX:SDTYP["W",GETNXD:SDTYP["D"
|
|---|
| 36 | .Q
|
|---|
| 37 | G:$D(SDERRFT) ADT
|
|---|
| 38 | END W !,SDMCNT," APPOINTMENTS MADE",!
|
|---|
| 39 | ;display all created appointments
|
|---|
| 40 | I $D(^TMP($J,"APPT")) N SDEV D EN^SDWLEVAL(DFN,.SDEV) I SDEV,$L(SDEV(1))>0 D
|
|---|
| 41 | .K ^TMP("SDWLPL",$J),^TMP($J,"SDWLPL")
|
|---|
| 42 | .D INIT^SDWLPL(DFN,"M")
|
|---|
| 43 | .Q:'$D(^TMP($J,"SDWLPL")) ;
|
|---|
| 44 | .;D LIST^SDWLPL("M",DFN) ;display EWL entries
|
|---|
| 45 | .F Q:'$D(^TMP($J,"SDWLPL")) D LIST^SDWLPL("M",DFN) N SDR D ANSW^SDWLEVAL(1,.SDR) I 'SDR D ;D LIST^SDWLPL("M",DFN) D
|
|---|
| 46 | ..F N SDR D ANSW^SDWLEVAL(0,.SDR) Q:'$D(^TMP($J,"SDWLPL")) I 'SDR W !,"MUST ENTER A REASON NOT TO DISPOSITION MATCHED EWL ENTRY",!
|
|---|
| 47 | I $D(^TMP($J,"APPT")) N SDEV D EN^SDWLEVAL(DFN,.SDEV) I SDEV,$L(SDEV(1))>0 D
|
|---|
| 48 | .;N SDTC D EWLANS^SDWLEVAL(.SDTC) ;user may reject EWL; 446/;
|
|---|
| 49 | .;ask for selection of EWL to display
|
|---|
| 50 | .;ASKS - returned answer (A/C/S/^)
|
|---|
| 51 | .; ^TMP("SDWLPL",$J) and ^TMP($J,"SDWLPL") are used
|
|---|
| 52 | .; to generate EWL open entries
|
|---|
| 53 | .;I SDTC N SDCTN S SDCTN=0 F N ASKS K ^TMP("SDWLPL",$J),^TMP($J,"SDWLPL") D ANS2^SDWLPL(DFN,.ASKS) Q:ASKS="^" D Q:SDCTN ;446/;
|
|---|
| 54 | .Q:'$D(^TMP($J,"SDWLPL")) D ASKREM^SDWLEVAL S SDCTN=1 ;display and process selected open EWL entries ;446/;
|
|---|
| 55 | .;I 'SDTC Q ;no EWL evaluation per user's decision
|
|---|
| 56 | .Q
|
|---|
| 57 | ;
|
|---|
| 58 | K CCX,COLLAT,COV,D,I,POP,S,SC,SD,SDAPTYP,SDEDT,SDEMP,SDINA,SDLOCK,SDM9,SDMES,SDNOT,SDRE,SDSOH,SDW,SDWEE,SDX3,SDX7,SDX9,SDY1,SDYC,SDZ,SDZY,SDMES,SDCN,SDDAT,SDMADE,SDMCNT,SDOT,SDPL,SDRT,SDSC,SDTTM,SDTYP
|
|---|
| 59 | K SDALLE,SDATD,SDAV,SDDECOD,SDEC,SDHX,SDIN,SDINP,SDOEL,SDT,SDY,%H,%T,C,DISYS,SDW,SDWE,SDX3,SDX7,SDX9,SDY1,SDYC,SDZY,SI,SL,SM,SS,X1,X2,Y,SDXF,% Q
|
|---|
| 60 | GETNEX I SDDAT#100<22 S SDDAT=SDDAT+7 S POP=0 D INACT Q:POP G:$D(^HOLIDAY(SDDAT,0))&('SDSOH) GETNEX S Y=SDDAT_SDOT Q
|
|---|
| 61 | S X1=SDDAT,X2=7 D C^%DTC S POP=0 D INACT Q:POP S SDDAT=X G:$D(^HOLIDAY(SDDAT,0))&('SDSOH) GETNEX S Y=SDDAT_SDOT
|
|---|
| 62 | Q
|
|---|
| 63 | GETNXD I SDDAT#100<28 S SDDAT=SDDAT+1 S POP=0 D INACT Q:POP G:$D(^HOLIDAY(SDDAT,0))&('SDSOH) GETNXD S X=SDDAT D DOW^SDM0 S:SDWE["Y" Y=SDDAT_SDOT Q:SDWE["Y" G:Y=0!(Y=6) GETNXD S Y=SDDAT_SDOT Q
|
|---|
| 64 | S X1=SDDAT,X2=1 D C^%DTC S POP=0 D INACT Q:POP S SDDAT=X G:$D(^HOLIDAY(SDDAT,0))&('SDSOH) GETNXD S X=SDDAT D DOW^SDM0 S:SDWE["Y" Y=SDDAT_SDOT Q:SDWE["Y" G:Y=0!(Y=6) GETNXD S Y=SDDAT_SDOT
|
|---|
| 65 | Q
|
|---|
| 66 | DAY ;;^SUN^MON^TUES^WEDNES^THURS^FRI^SATUR
|
|---|
| 67 | ;
|
|---|
| 68 | TM S X=$E($P(X,".",2)_"0000",1,4),%=X>1159 S:X>1259 X=X-1200 S X=X\100_":"_$E(X#100+100,2,3)_" "_$E("AP",%+1)_"M" Q
|
|---|
| 69 | HLP W !,"Enter the number of appointments you want made (between 1 and 60)." G RDC
|
|---|
| 70 | HLP22 W !,"ENTER 'YES' IF YOU WANT THE SYSTEM TO TRY TO MAKE APPOINTMENTS ON SATURDAYS AND SUNDAYS" G RD22
|
|---|
| 71 | INACT I $D(SDINA),SDINA'>SDDAT,SDRE>SDDAT!('SDRE) W !,*7,"Appointments can't be made while clinic is inactivated" S POP=1
|
|---|
| 72 | Q
|
|---|
| 73 | HLP1 W !,"Enter a date/time for the appointment"
|
|---|
| 74 | W:$D(SD) " or a space to choose the same date/time",!,"as the patient you have just previously scheduled into this clinic"
|
|---|
| 75 | W ".",!,"You may also select 'M' to display the next month's availability or"
|
|---|
| 76 | W !,"'D' to specify an earlier or later date to begin the availability display."
|
|---|
| 77 | Q
|
|---|
| 78 | SDFT S X1=DT,SDEDT=$S($D(^SC(SC,"SDP")):$P(^("SDP"),U,2),1:365) S:'SDEDT SDEDT=365 S X2=SDEDT D C^%DTC S SDEDT=X Q
|
|---|
| 79 | MSG W !!?5,"Text entered at OTHER INFO prompt was too long. Please re-enter.",! Q
|
|---|
| 80 | ;
|
|---|
| 81 | MORDIS I '$D(SDHX) W *7," ??" G ADT
|
|---|
| 82 | S SDXF=0,X1=SDHX,X2=1 D C^%DTC
|
|---|
| 83 | MORD2 I $D(SDINA),SDINA'>X,SDRE>X!('SDRE) S SDHY=$S($D(Y):Y,1:""),Y=SDINA D DTS^SDUTL W *7,!,"Clinic is inactivated as of ",Y S Y=SDHY K SDHY G ADT
|
|---|
| 84 | EN S:$L(X)=1 X=$TR(X,"tnN","TTT") S:X="NOW" X="T" I X?.A!(+X=X),X<13,X'?1"T".E S X=X_" 1"
|
|---|
| 85 | D Q:Y<1
|
|---|
| 86 | .N %DT
|
|---|
| 87 | .S %DT="T" D ^%DT
|
|---|
| 88 | .I Y<1 W !!,"Unable to evaluate date value """_X_""".",!
|
|---|
| 89 | .Q
|
|---|
| 90 | S:$S($D(DUZ)'[0:1,1:0) ^DISV(DUZ_U_+SC)=Y
|
|---|
| 91 | DISP S IOF=$S('$D(IOF):"!#",IOF']"":"!#",1:IOF) W @IOF S SDSOH=$S('$D(^SC(+SC,"SL")):0,$P(^("SL"),"^",8)']"":0,1:1),SDAV=0
|
|---|
| 92 | I $D(SDINA),Y'<SDINA,SDRE>Y!('SDRE) S SDHY=Y,Y=SDINA D DTS^SDUTL W !,*7,"Clinic is inactive ",$S(SDRE:"from ",1:"as of "),Y S Y=SDRE D:Y DTS^SDUTL W $S(SDRE:" to "_Y,1:"") S Y=SDHY K SDHY Q:'SDRE
|
|---|
| 93 | S:Y#100=0 Y=Y+1 S X=Y D D^SDM0:$E(X,4,5) S (SDX,X1)=X,X2=1 D C^%DTC S X=SDX K SDX Q
|
|---|
