SDC4.m

SDC4 ;ALB/MJK - Check Range for CO'ed Appts; 28 JUN 1993

 ;;5.3;Scheduling;**1002,1015**;Aug 13, 1993;Build 21

 ;

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

 ..;IHS/ITSC/WAR 1/27/2005 PATCH #1002 Can't Cancel CL w/a CKD-IN Pt

 ..; Added next line and code to line tag MES (see below) 

 ..I $P(SDC,U,1),'$P(SDC,U,3) S SDESC=-1  ;CK-IN, BUT NOT CKD-OUT YET

 ..I $P(SDC,U,3) S SDESC=1

 I SDESC,SDMSG D MES

 Q SDESC

 ;

MES ; -- write warning to user

 ;IHS/ITSC/WAR 1/27/2005 PATCH #1002 Added If/Else and addt'l msg

 ;  Original code only had 6 lines of code which follow: 

 ;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 ! 

 I SDESC=-1 D

 .N X S X="IOBON;IOBOFF"

 .D ENDR^%ZISS

 .W *7

 .W !!?5,"It appears that there is a patient checked in, but not yet"

 .W !?5,"checked out for the "

 .W $S(SDEND[".2359":"DAY ",1:"TIME RANGE ")

 .W "you have selected."

 .W IOBON

 .W !!?5,"     Action must be taken to CK-OUT the patient"

 .W !?5,"       before this process can be completed."

 .W IOBOFF

 .;D KILL^%ZISS  ;Removes only variables defined with ENDR^%ZISS

 E  D

 .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 !

 ;IHS/ITSC/WAR 1/27/2005 PATCH #1002 End of changes.

 Q

SDC4      ;ALB/MJK - Check Range for CO'ed Appts; 28 JUN 1993

 +1       ;;5.3;Scheduling;**1002,1015**;Aug 13, 1993;Build 21

 +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       ;IHS/ITSC/WAR 1/27/2005 PATCH #1002 Can't Cancel CL w/a CKD-IN Pt

 +7       ; Added next line and code to line tag MES (see below) 

 +8       ;CK-IN, BUT NOT CKD-OUT YET

                           IF $PIECE(SDC,U,1)

                               IF '$PIECE(SDC,U,3)

                                   SET SDESC=-1

 +9                        IF $PIECE(SDC,U,3)

                               SET SDESC=1

                       End DoDot:2

               End DoDot:1

 +10       IF SDESC

               IF SDMSG

                   DO MES

 +11       QUIT SDESC

 +12      ;

MES       ; -- write warning to user

 +1       ;IHS/ITSC/WAR 1/27/2005 PATCH #1002 Added If/Else and addt'l msg

 +2       ;  Original code only had 6 lines of code which follow: 

 +3       ;W *7

 +4       ;W !?5,"At least one appointment has been checked out in the time"

 +5       ;W !?5,"period selected."

 +6       ;W !!?5,"As a result, to avoid the loss of workload credit, you are"

 +7       ;W !?5,"not allowed to cancel availability for this time period."

 +8       ;W ! 

 +9        IF SDESC=-1

               Begin DoDot:1

 +10               NEW X

                   SET X="IOBON;IOBOFF"

 +11               DO ENDR^%ZISS

 +12               WRITE *7

 +13               WRITE !!?5,"It appears that there is a patient checked in, but not yet"

 +14               WRITE !?5,"checked out for the "

 +15               WRITE $SELECT(SDEND[".2359":"DAY ",1:"TIME RANGE ")

 +16               WRITE "you have selected."

 +17               WRITE IOBON

 +18               WRITE !!?5,"     Action must be taken to CK-OUT the patient"

 +19               WRITE !?5,"       before this process can be completed."

 +20               WRITE IOBOFF

 +21      ;D KILL^%ZISS  ;Removes only variables defined with ENDR^%ZISS

               End DoDot:1

 +22      IF '$TEST

               Begin DoDot:1

 +23               WRITE *7

 +24               WRITE !?5,"At least one appointment has been checked out in the time"

 +25               WRITE !?5,"period selected."

 +26               WRITE !!?5,"As a result, to avoid the loss of workload credit, you are"

 +27               WRITE !?5,"not allowed to cancel availability for this time period."

               End DoDot:1

 +28       WRITE !

 +29      ;IHS/ITSC/WAR 1/27/2005 PATCH #1002 End of changes.

 +30       QUIT