SDUTL ;MAN/GRR - SCHEDULING UTILITY PROGRAM ; 18 JUN 84 11:31 AM
;;5.3;Scheduling;**140,356**;Aug 13, 1993
DATE S:$D(%DT(0)) SDT0=%DT(0) S:$D(SDT00) %DT=SDT00 S POP=0 K BEGDATE,ENDDATE W !!,"**** Date Range Selection ****"
W ! S %DT=$S($D(SDT00):SDT00,1:"AE"),%DT("A")=" Beginning DATE : "
D ^%DT S:Y<0 POP=1 G:Y<0 EX S (BEGDATE,SDBD)=Y
W ! S %DT=$S($D(SDT00):SDT00,1:"AE"),%DT("A")=" Ending DATE : "
D ^%DT K %DT S:Y<0 POP=1 G:Y<0 EX G:Y<SDBD HELP W ! S (ENDDATE,SDED)=Y
EX K SDT0,SDT00 Q
;
Q G QUE^DGUTQ
;
DQ G DQ^DGUTQ
;
ZIS G ZIS^DGUTQ
K PGM,VAL,VAR Q
;
CLOSE G CLOSE^DGUTQ Q
Q
TIME D DT S SDZ01=$H,SDTIME=$P(SDZ01,",",2),SDTIME=DT_(SDTIME\60#60/100+(SDTIME\3600)/100)
Q
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
Q
OUT W *7 I ($Y+4)<IOSL F SDXX=$Y:1:IOSL-4 W !
R !!,"Press return to continue or ""^"" to escape ",X:DTIME I X["^"!('$T) S SDEND=1
Q
DTS S Y=$TR($$FMTE^XLFDT(Y,"5DF")," ","0") Q
DT K %DT S X="T" D ^%DT S DT=Y,U="^" Q
DIV I $D(^DG(43,1,"GL")),$P(^("GL"),"^",2)
Q
AT S Y1=$S(+$P(Y,".",2):"."_$P(Y,".",2),1:""),Y=$S(+$P(Y,".",1):$P(Y,".",1),1:"")
I Y]"" D D^DIQ
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"
I Y]"",Y1]"" S Y=Y_" @"_Y1
I Y']"",Y1]"" S Y=Y1
K Y1,Y2 Q
LAPPT W *7,!,"Appointment length is inconsistent with inc/hr (",SDZ0,") for this clinic" K X
Q
RT Q:$S(SDTTM<DT:1,'$D(^DIC(195.4,1,"UP")):1,'^("UP"):1,1:0)
I SDRT="A" D QUE^RTQ2 Q
I SDRT="D",$D(^SC(SDSC,"S",SDTTM,1,SDPL,"RTR")),^("RTR") S RTPAR=+^("RTR") D CANCEL^RTQ2 K RTPAR Q
Q
;
RTSET I $D(^SC(SDSC,"S",SDTTM,1,SDPL,0)),DFN=+^(0),$P(^(0),"^",9)'["C",'$D(^("RTR")) S ^("RTR")=RTPAR
Q
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
I S:'$D(DTIME) DTIME=300 D:'$D(DT) DT S:'$D(U) U="^" Q
HELP W "??",!?5,"Ending date must not be before beginning date" S:$D(SDT0) %DT(0)=SDT0 G DATE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDUTL 2072 printed Oct 16, 2024@19:02:14 Page 2
SDUTL ;MAN/GRR - SCHEDULING UTILITY PROGRAM ; 18 JUN 84 11:31 AM
+1 ;;5.3;Scheduling;**140,356**;Aug 13, 1993
DATE if $DATA(%DT(0))
SET SDT0=%DT(0)
if $DATA(SDT00)
SET %DT=SDT00
SET POP=0
KILL BEGDATE,ENDDATE
WRITE !!,"**** Date Range Selection ****"
+1 WRITE !
SET %DT=$SELECT($DATA(SDT00):SDT00,1:"AE")
SET %DT("A")=" Beginning DATE : "
+2 DO ^%DT
if Y<0
SET POP=1
if Y<0
GOTO EX
SET (BEGDATE,SDBD)=Y
+3 WRITE !
SET %DT=$SELECT($DATA(SDT00):SDT00,1:"AE")
SET %DT("A")=" Ending DATE : "
+4 DO ^%DT
KILL %DT
if Y<0
SET POP=1
if Y<0
GOTO EX
if Y<SDBD
GOTO HELP
WRITE !
SET (ENDDATE,SDED)=Y
EX KILL SDT0,SDT00
QUIT
+1 ;
Q GOTO QUE^DGUTQ
+1 ;
DQ GOTO DQ^DGUTQ
+1 ;
ZIS GOTO ZIS^DGUTQ
+1 KILL PGM,VAL,VAR
QUIT
+2 ;
CLOSE GOTO CLOSE^DGUTQ
QUIT
+1 QUIT
TIME DO DT
SET SDZ01=$HOROLOG
SET SDTIME=$PIECE(SDZ01,",",2)
SET SDTIME=DT_(SDTIME\60#60/100+(SDTIME\3600)/100)
+1 QUIT
ETIME SET Y=(X-SD00)*86400
SET X1=$PIECE(X,",",2)
SET X2=$PIECE(SD00,",",2)
SET X3=Y-X2+X1
SET X=X3\3600
SET X1=X3#3600\60
+1 QUIT
OUT WRITE *7
IF ($Y+4)<IOSL
FOR SDXX=$Y:1:IOSL-4
WRITE !
+1 READ !!,"Press return to continue or ""^"" to escape ",X:DTIME
IF X["^"!('$TEST)
SET SDEND=1
+2 QUIT
DTS SET Y=$TRANSLATE($$FMTE^XLFDT(Y,"5DF")," ","0")
QUIT
DT KILL %DT
SET X="T"
DO ^%DT
SET DT=Y
SET U="^"
QUIT
DIV IF $DATA(^DG(43,1,"GL"))
IF $PIECE(^("GL"),"^",2)
+1 QUIT
AT SET Y1=$SELECT(+$PIECE(Y,".",2):"."_$PIECE(Y,".",2),1:"")
SET Y=$SELECT(+$PIECE(Y,".",1):$PIECE(Y,".",1),1:"")
+1 IF Y]""
DO D^DIQ
+2 IF Y1]""
SET Y1=$EXTRACT($PIECE(Y1,".",2)_"0000",1,4)
SET Y2=Y1>1159
if Y1>1259
SET Y1=Y1-1200
SET Y1=Y1\100_":"_$EXTRACT(Y1#100+100,2,3)_" "_$EXTRACT("AP",Y2+1)_"M"
+3 IF Y]""
IF Y1]""
SET Y=Y_" @"_Y1
+4 IF Y']""
IF Y1]""
SET Y=Y1
+5 KILL Y1,Y2
QUIT
LAPPT WRITE *7,!,"Appointment length is inconsistent with inc/hr (",SDZ0,") for this clinic"
KILL X
+1 QUIT
RT if $SELECT(SDTTM<DT
QUIT
+1 IF SDRT="A"
DO QUE^RTQ2
QUIT
+2 IF SDRT="D"
IF $DATA(^SC(SDSC,"S",SDTTM,1,SDPL,"RTR"))
IF ^("RTR")
SET RTPAR=+^("RTR")
DO CANCEL^RTQ2
KILL RTPAR
QUIT
+3 QUIT
+4 ;
RTSET IF $DATA(^SC(SDSC,"S",SDTTM,1,SDPL,0))
IF DFN=+^(0)
IF $PIECE(^(0),"^",9)'["C"
IF '$DATA(^("RTR"))
SET ^("RTR")=RTPAR
+1 QUIT
NOTES KILL IOP
SET L=0
SET DIC="^DIC(9.4,"
SET FLDS="[SDREL]"
SET BY="[SDREL]"
SET FR="""SCHEDULING"",3.8"
SET TO=FR
SET DHD="SCHEDULING V3.8 RELEASE NOTES"
GOTO EN1^DIP
I if '$DATA(DTIME)
SET DTIME=300
if '$DATA(DT)
DO DT
if '$DATA(U)
SET U="^"
QUIT
HELP WRITE "??",!?5,"Ending date must not be before beginning date"
if $DATA(SDT0)
SET %DT(0)=SDT0
GOTO DATE
