SDC4 ;ALB/MJK - Check Range for CO'ed Appts; 28 JUN 1993
;;5.3;Scheduling;;Aug 13, 1993
;
COED(SDCL,SDBEG,SDEND,SDMSG) ; -- scan appts for those co'ed
N SDDA,SDATE,SD0,SDC,SDESC
S SDESC=0,SDATE=SDBEG-.0000001
F S SDATE=$O(^SC(SDCL,"S",SDATE)) Q:'SDATE!(SDATE>SDEND) D
.S SDDA=0 F S SDDA=$O(^SC(SDCL,"S",SDATE,1,SDDA)) Q:'SDDA S SD0=^(SDDA,0),SDC=$G(^("C")) D
..I $P(SD0,U,9)="C" Q
..I $P(SDC,U,3) S SDESC=1
I SDESC,SDMSG D MES
Q SDESC
;
MES ; -- write warning to user
W *7
W !?5,"At least one appointment has been checked out in the time"
W !?5,"period selected."
W !!?5,"As a result, to avoid the loss of workload credit, you are"
W !?5,"not allowed to cancel availability for this time period."
W !
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDC4 746 printed Oct 16, 2024@18:49:22 Page 2
SDC4 ;ALB/MJK - Check Range for CO'ed Appts; 28 JUN 1993
+1 ;;5.3;Scheduling;;Aug 13, 1993
+2 ;
COED(SDCL,SDBEG,SDEND,SDMSG) ; -- scan appts for those co'ed
+1 NEW SDDA,SDATE,SD0,SDC,SDESC
+2 SET SDESC=0
SET SDATE=SDBEG-.0000001
+3 FOR
SET SDATE=$ORDER(^SC(SDCL,"S",SDATE))
if 'SDATE!(SDATE>SDEND)
QUIT
Begin DoDot:1
+4 SET SDDA=0
FOR
SET SDDA=$ORDER(^SC(SDCL,"S",SDATE,1,SDDA))
if 'SDDA
QUIT
SET SD0=^(SDDA,0)
SET SDC=$GET(^("C"))
Begin DoDot:2
+5 IF $PIECE(SD0,U,9)="C"
QUIT
+6 IF $PIECE(SDC,U,3)
SET SDESC=1
End DoDot:2
End DoDot:1
+7 IF SDESC
IF SDMSG
DO MES
+8 QUIT SDESC
+9 ;
MES ; -- write warning to user
+1 WRITE *7
+2 WRITE !?5,"At least one appointment has been checked out in the time"
+3 WRITE !?5,"period selected."
+4 WRITE !!?5,"As a result, to avoid the loss of workload credit, you are"
+5 WRITE !?5,"not allowed to cancel availability for this time period."
+6 WRITE !
+7 QUIT
