- 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 Feb 19, 2025@00:15:14 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