- SDC2 ;ALB/GRR - CHECK PARTIAL CANCELLATIONS ; 19 FEB 85
- ;;5.3;Scheduling;**182,452,1015**;Aug 13, 1993;Build 21
- ;IHS/ANMC/LJF 12/13/2000 added code to allow 10 hour days
- ;
- K SDZ I $D(^SC(SC,"SDCAN")),$O(^SC(SC,"SDCAN",SD))\1=SD G OVR
- D WAIT^DICD F SDZL=SD:0 S SDZL=$O(^SC(SC,"S",SDZL)) Q:SDZL="" I $D(^SC(SC,"S",SDZL,"MES")) S SDCTO=$E(^("MES"),17,20) S:'$D(^SC(SC,"SDCAN",0)) ^SC(SC,"SDCAN",0)="^44.05D^"_SDZL_"^0" D MORE
- G:'$D(^SC(SC,"SDCAN")) W^SDC G:$O(^SC(SC,"SDCAN",SD))\1-SD W^SDC
- OVR F SDJ=SD:0 S SDJ=$O(^SC(SC,"SDCAN",SDJ)) Q:SDJ=""!(SDJ\1-SD) S SDZ(SDJ)=SD_($P(^(SDJ,0),"^",2)/10000)_$S($D(^SC(SC,"S",SDJ,"MES")):" ("_$P(^("MES"),"(",2),1:"")
- SHOW W !,"Clinic already has the following cancellation(s) for that date: ",!
- F Z=0:0 S Z=$O(SDZ(Z)) Q:Z="" S X=Z D TM W !,?15,"From: ",X," To: " S X=+SDZ(Z) D TM W X,$S($P(SDZ(Z),"(",2)]"":" ("_$P(SDZ(Z),"(",2),1:"")
- CP S %=1 W !!,"Do you want to Cancel another portion of the day" D YN^DICN I '% W !,"REPLY YES (Y) OR NO (N)" G CP
- W:%<0 " NO" S SDANS=$S('(%-1):"Y",1:"N") Q:SDANS'["Y"
- RDFR R !,"STARTING TIME: ",X:DTIME Q:"^"[X D TC G RDFR:Y<0 S FR=Y,ST=%
- RDTO R !,"ENDING TIME: ",X:DTIME Q:"^"[X D TC G RDTO:Y<0 S SDHTO=X,TO=Y I TO'>FR W !,*7,"Ending time must be later than starting time!" G RDTO
- D TZ G:'$D(X) SHOW
- G ROPT^SDC
- TC S X=$$FMTE^XLFDT(SD)_"@"_X,%DT="TE" D ^%DT I Y<0!(X["?") W !,"Enter a time after starting time",!,"for clinic and which is a valid time for clinic.",*7 Q
- S X=$E($P(Y_"0000",".",2),1,4),%=$E(X,3,4),%=X\100-STARTDAY*SI+(%*SI\60)*2 I %<0 W !,*7,"DAY STARTS AT ",STARTDAY S Y=-1
- ;I %>72 W *7,"?" S Y=-1 ;IHS/ANMC/LJF 12/13/2000
- I %>125 W *7,"?" S Y=-1 ;IHS/ANMC/LJF 12/13/2000
- Q
- TZ K SDERR F Z=0:0 S Z=$O(SDZ(Z)) Q:Z="" S SDERR=$S(FR'<Z&(FR<SDZ(Z)):1,TO>Z&(TO<SDZ(Z)):1,1:0) Q:SDERR I Z'<FR&(Z<TO) S SDERR=1 Q
- G:SDERR ERR
- Q
- MORE Q:$D(^SC(SC,"SDCAN",SDZL,0)) S A=^SC(SC,"SDCAN",0),SDCNT=$P(A,"^",4),^SC(SC,"SDCAN",0)=$P(A,"^",1,2)_"^"_SDZL_"^"_(SDCNT+1),^SC(SC,"SDCAN",SDZL,0)=SDZL_"^"_SDCTO
- Q
- ERR W !!,*7,"Time frame selected overlaps previously cancelled time frame!",! K X Q
- 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
- SDC2 ;ALB/GRR - CHECK PARTIAL CANCELLATIONS ; 19 FEB 85
- +1 ;;5.3;Scheduling;**182,452,1015**;Aug 13, 1993;Build 21
- +2 ;IHS/ANMC/LJF 12/13/2000 added code to allow 10 hour days
- +3 ;
- +4 KILL SDZ
- IF $DATA(^SC(SC,"SDCAN"))
- IF $ORDER(^SC(SC,"SDCAN",SD))\1=SD
- GOTO OVR
- +5 DO WAIT^DICD
- FOR SDZL=SD:0
- SET SDZL=$ORDER(^SC(SC,"S",SDZL))
- IF SDZL=""
- QUIT
- IF $DATA(^SC(SC,"S",SDZL,"MES"))
- SET SDCTO=$EXTRACT(^("MES"),17,20)
- IF '$DATA(^SC(SC,"SDCAN",0))
- SET ^SC(SC,"SDCAN",0)="^44.05D^"_SDZL_"^0"
- DO MORE
- +6 IF '$DATA(^SC(SC,"SDCAN"))
- GOTO W^SDC
- IF $ORDER(^SC(SC,"SDCAN",SD))\1-SD
- GOTO W^SDC
- OVR FOR SDJ=SD:0
- SET SDJ=$ORDER(^SC(SC,"SDCAN",SDJ))
- IF SDJ=""!(SDJ\1-SD)
- QUIT
- SET SDZ(SDJ)=SD_($PIECE(^(SDJ,0),"^",2)/10000)_$SELECT($DATA(^SC(SC,"S",SDJ,"MES")):" ("_$PIECE(^("MES"),"(",2),1:"")
- SHOW WRITE !,"Clinic already has the following cancellation(s) for that date: ",!
- +1 FOR Z=0:0
- SET Z=$ORDER(SDZ(Z))
- IF Z=""
- QUIT
- SET X=Z
- DO TM
- WRITE !,?15,"From: ",X," To: "
- SET X=+SDZ(Z)
- DO TM
- WRITE X,$SELECT($PIECE(SDZ(Z),"(",2)]"":" ("_$PIECE(SDZ(Z),"(",2),1:"")
- CP SET %=1
- WRITE !!,"Do you want to Cancel another portion of the day"
- DO YN^DICN
- IF '%
- WRITE !,"REPLY YES (Y) OR NO (N)"
- GOTO CP
- +1 IF %<0
- WRITE " NO"
- SET SDANS=$SELECT('(%-1):"Y",1:"N")
- IF SDANS'["Y"
- QUIT
- RDFR READ !,"STARTING TIME: ",X:DTIME
- IF "^"[X
- QUIT
- DO TC
- IF Y<0
- GOTO RDFR
- SET FR=Y
- SET ST=%
- RDTO READ !,"ENDING TIME: ",X:DTIME
- IF "^"[X
- QUIT
- DO TC
- IF Y<0
- GOTO RDTO
- SET SDHTO=X
- SET TO=Y
- IF TO'>FR
- WRITE !,*7,"Ending time must be later than starting time!"
- GOTO RDTO
- +1 DO TZ
- IF '$DATA(X)
- GOTO SHOW
- +2 GOTO ROPT^SDC
- TC SET X=$$FMTE^XLFDT(SD)_"@"_X
- SET %DT="TE"
- DO ^%DT
- IF Y<0!(X["?")
- WRITE !,"Enter a time after starting time",!,"for clinic and which is a valid time for clinic.",*7
- QUIT
- +1 SET X=$EXTRACT($PIECE(Y_"0000",".",2),1,4)
- SET %=$EXTRACT(X,3,4)
- SET %=X\100-STARTDAY*SI+(%*SI\60)*2
- IF %<0
- WRITE !,*7,"DAY STARTS AT ",STARTDAY
- SET Y=-1
- +2 ;I %>72 W *7,"?" S Y=-1 ;IHS/ANMC/LJF 12/13/2000
- +3 ;IHS/ANMC/LJF 12/13/2000
- IF %>125
- WRITE *7,"?"
- SET Y=-1
- +4 QUIT
- TZ KILL SDERR
- FOR Z=0:0
- SET Z=$ORDER(SDZ(Z))
- IF Z=""
- QUIT
- SET SDERR=$SELECT(FR'<Z&(FR<SDZ(Z)):1,TO>Z&(TO<SDZ(Z)):1,1:0)
- IF SDERR
- QUIT
- IF Z'<FR&(Z<TO)
- SET SDERR=1
- QUIT
- +1 IF SDERR
- GOTO ERR
- +2 QUIT
- MORE IF $DATA(^SC(SC,"SDCAN",SDZL,0))
- QUIT
- SET A=^SC(SC,"SDCAN",0)
- SET SDCNT=$PIECE(A,"^",4)
- SET ^SC(SC,"SDCAN",0)=$PIECE(A,"^",1,2)_"^"_SDZL_"^"_(SDCNT+1)
- SET ^SC(SC,"SDCAN",SDZL,0)=SDZL_"^"_SDCTO
- +1 QUIT
- ERR WRITE !!,*7,"Time frame selected overlaps previously cancelled time frame!",!
- KILL X
- QUIT
- TM SET X=$EXTRACT($PIECE(X,".",2)_"0000",1,4)
- SET %=X>1159
- IF X>1259
- SET X=X-1200
- SET X=X\100_":"_$EXTRACT(X#100+100,2,3)_" "_$EXTRACT("AP",%+1)_"M"
- QUIT
