- SDUTL ;MAN/GRR - SCHEDULING UTILITY PROGRAM ; 18 JUN 84 11:31 AM
- ;;5.3;Scheduling;**140,356,1015**;Aug 13, 1993;Build 21
- ;
- 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
- SDUTL ;MAN/GRR - SCHEDULING UTILITY PROGRAM ; 18 JUN 84 11:31 AM
- +1 ;;5.3;Scheduling;**140,356,1015**;Aug 13, 1993;Build 21
- +2 ;
- 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
