| 1 | SDUTL ;MAN/GRR - SCHEDULING UTILITY PROGRAM ; 18 JUN 84 11:31 AM
|
|---|
| 2 | ;;5.3;Scheduling;**140,356**;Aug 13, 1993
|
|---|
| 3 | DATE S:$D(%DT(0)) SDT0=%DT(0) S:$D(SDT00) %DT=SDT00 S POP=0 K BEGDATE,ENDDATE W !!,"**** Date Range Selection ****"
|
|---|
| 4 | W ! S %DT=$S($D(SDT00):SDT00,1:"AE"),%DT("A")=" Beginning DATE : "
|
|---|
| 5 | D ^%DT S:Y<0 POP=1 G:Y<0 EX S (BEGDATE,SDBD)=Y
|
|---|
| 6 | W ! S %DT=$S($D(SDT00):SDT00,1:"AE"),%DT("A")=" Ending DATE : "
|
|---|
| 7 | D ^%DT K %DT S:Y<0 POP=1 G:Y<0 EX G:Y<SDBD HELP W ! S (ENDDATE,SDED)=Y
|
|---|
| 8 | EX K SDT0,SDT00 Q
|
|---|
| 9 | ;
|
|---|
| 10 | Q G QUE^DGUTQ
|
|---|
| 11 | ;
|
|---|
| 12 | DQ G DQ^DGUTQ
|
|---|
| 13 | ;
|
|---|
| 14 | ZIS G ZIS^DGUTQ
|
|---|
| 15 | K PGM,VAL,VAR Q
|
|---|
| 16 | ;
|
|---|
| 17 | CLOSE G CLOSE^DGUTQ Q
|
|---|
| 18 | Q
|
|---|
| 19 | TIME D DT S SDZ01=$H,SDTIME=$P(SDZ01,",",2),SDTIME=DT_(SDTIME\60#60/100+(SDTIME\3600)/100)
|
|---|
| 20 | Q
|
|---|
| 21 | ETIME S Y=(X-SD00)*86400,X1=$P(X,",",2),X2=$P(SD00,",",2),X3=Y-X2+X1,X=X3\3600,X1=X3#3600\60
|
|---|
| 22 | Q
|
|---|
| 23 | OUT W *7 I ($Y+4)<IOSL F SDXX=$Y:1:IOSL-4 W !
|
|---|
| 24 | R !!,"Press return to continue or ""^"" to escape ",X:DTIME I X["^"!('$T) S SDEND=1
|
|---|
| 25 | Q
|
|---|
| 26 | DTS S Y=$TR($$FMTE^XLFDT(Y,"5DF")," ","0") Q
|
|---|
| 27 | DT K %DT S X="T" D ^%DT S DT=Y,U="^" Q
|
|---|
| 28 | DIV I $D(^DG(43,1,"GL")),$P(^("GL"),"^",2)
|
|---|
| 29 | Q
|
|---|
| 30 | AT S Y1=$S(+$P(Y,".",2):"."_$P(Y,".",2),1:""),Y=$S(+$P(Y,".",1):$P(Y,".",1),1:"")
|
|---|
| 31 | I Y]"" D D^DIQ
|
|---|
| 32 | I Y1]"" S Y1=$E($P(Y1,".",2)_"0000",1,4),Y2=Y1>1159 S:Y1>1259 Y1=Y1-1200 S Y1=Y1\100_":"_$E(Y1#100+100,2,3)_" "_$E("AP",Y2+1)_"M"
|
|---|
| 33 | I Y]"",Y1]"" S Y=Y_" @"_Y1
|
|---|
| 34 | I Y']"",Y1]"" S Y=Y1
|
|---|
| 35 | K Y1,Y2 Q
|
|---|
| 36 | LAPPT W *7,!,"Appointment length is inconsistent with inc/hr (",SDZ0,") for this clinic" K X
|
|---|
| 37 | Q
|
|---|
| 38 | RT Q:$S(SDTTM<DT:1,'$D(^DIC(195.4,1,"UP")):1,'^("UP"):1,1:0)
|
|---|
| 39 | I SDRT="A" D QUE^RTQ2 Q
|
|---|
| 40 | I SDRT="D",$D(^SC(SDSC,"S",SDTTM,1,SDPL,"RTR")),^("RTR") S RTPAR=+^("RTR") D CANCEL^RTQ2 K RTPAR Q
|
|---|
| 41 | Q
|
|---|
| 42 | ;
|
|---|
| 43 | RTSET I $D(^SC(SDSC,"S",SDTTM,1,SDPL,0)),DFN=+^(0),$P(^(0),"^",9)'["C",'$D(^("RTR")) S ^("RTR")=RTPAR
|
|---|
| 44 | Q
|
|---|
| 45 | NOTES K IOP S L=0,DIC="^DIC(9.4,",FLDS="[SDREL]",BY="[SDREL]",FR="""SCHEDULING"",3.8",TO=FR,DHD="SCHEDULING V3.8 RELEASE NOTES" G EN1^DIP
|
|---|
| 46 | I S:'$D(DTIME) DTIME=300 D:'$D(DT) DT S:'$D(U) U="^" Q
|
|---|
| 47 | HELP W "??",!?5,"Ending date must not be before beginning date" S:$D(SDT0) %DT(0)=SDT0 G DATE
|
|---|
