source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDUTL.m@ 1147

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

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1SDUTL ;MAN/GRR - SCHEDULING UTILITY PROGRAM ; 18 JUN 84 11:31 AM
2 ;;5.3;Scheduling;**140,356**;Aug 13, 1993
3DATE 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
8EX K SDT0,SDT00 Q
9 ;
10Q G QUE^DGUTQ
11 ;
12DQ G DQ^DGUTQ
13 ;
14ZIS G ZIS^DGUTQ
15 K PGM,VAL,VAR Q
16 ;
17CLOSE G CLOSE^DGUTQ Q
18 Q
19TIME D DT S SDZ01=$H,SDTIME=$P(SDZ01,",",2),SDTIME=DT_(SDTIME\60#60/100+(SDTIME\3600)/100)
20 Q
21ETIME 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
23OUT 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
26DTS S Y=$TR($$FMTE^XLFDT(Y,"5DF")," ","0") Q
27DT K %DT S X="T" D ^%DT S DT=Y,U="^" Q
28DIV I $D(^DG(43,1,"GL")),$P(^("GL"),"^",2)
29 Q
30AT 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
36LAPPT W *7,!,"Appointment length is inconsistent with inc/hr (",SDZ0,") for this clinic" K X
37 Q
38RT 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 ;
43RTSET I $D(^SC(SDSC,"S",SDTTM,1,SDPL,0)),DFN=+^(0),$P(^(0),"^",9)'["C",'$D(^("RTR")) S ^("RTR")=RTPAR
44 Q
45NOTES 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
46I S:'$D(DTIME) DTIME=300 D:'$D(DT) DT S:'$D(U) U="^" Q
47HELP W "??",!?5,"Ending date must not be before beginning date" S:$D(SDT0) %DT(0)=SDT0 G DATE
Note: See TracBrowser for help on using the repository browser.