SRSBD1.m

SRSBD1 ;B'HAM ISC/MAM - DELETE SERVICE BLOCKOUT (CONT); 07/08/88  15:44

 ;;3.0; Surgery ;**26**;24 Jun 93

DAYCHK ; check to see if service is scheduled for the date selected

 I '$D(^SRS(SRSOR,"S",SRSDATE,0)) S SROR=SRSOR D GRAPH^SRSAVL

 S SRCHK=0,SRX1=11+($P(SRSST,".")*5)+(SRSST-$P(SRSST,".")*100\15),SRX2=11+($P(SRSET,".")*5)+(SRSET-$P(SRSET,".")*100\15) I $E(^SRS(SRSOR,"S",SRSDATE,1),SRX1,SRX2)'[SRSSER S SRCHK=1

 S SRX=SRX2-SRX1 I ((SRX1-1)#5!(SRX2#5)),SRX<9 S SRY=SRSSER_".",SRY=$E(SRY,1,4),SRZ=SRX1,SRN=^SRS(SRSOR,"S",SRSDATE,1),SRC=0 D

 .F J=1:1:SRX Q:SRC=1  S SRZ=SRZ+1 I SRZ#5'=1,$E(SRN,SRZ)'=$E(SRY,(SRZ-1)#5) S SRC=1 Q

 .I 'SRC S SRCHK=0

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SRSBD1   662     printed  Apr 09, 2024@21:50:58                                                                                                                                                                                                       Page 2

SRSBD1    ;B'HAM ISC/MAM - DELETE SERVICE BLOCKOUT (CONT); 07/08/88  15:44

 +1       ;;3.0; Surgery ;**26**;24 Jun 93

DAYCHK    ; check to see if service is scheduled for the date selected

 +1        IF '$DATA(^SRS(SRSOR,"S",SRSDATE,0))

               SET SROR=SRSOR

               DO GRAPH^SRSAVL

 +2        SET SRCHK=0

           SET SRX1=11+($PIECE(SRSST,".")*5)+(SRSST-$PIECE(SRSST,".")*100\15)

           SET SRX2=11+($PIECE(SRSET,".")*5)+(SRSET-$PIECE(SRSET,".")*100\15)

           IF $EXTRACT(^SRS(SRSOR,"S",SRSDATE,1),SRX1,SRX2)'[SRSSER

               SET SRCHK=1

 +3        SET SRX=SRX2-SRX1

           IF ((SRX1-1)#5!(SRX2#5))

               IF SRX<9

                   SET SRY=SRSSER_"."

                   SET SRY=$EXTRACT(SRY,1,4)

                   SET SRZ=SRX1

                   SET SRN=^SRS(SRSOR,"S",SRSDATE,1)

                   SET SRC=0

                   Begin DoDot:1

 +4                    FOR J=1:1:SRX

                           if SRC=1

                               QUIT 

                           SET SRZ=SRZ+1

                           IF SRZ#5'=1

                               IF $EXTRACT(SRN,SRZ)'=$EXTRACT(SRY,(SRZ-1)#5)

                                   SET SRC=1

                                   QUIT 

 +5                    IF 'SRC

                           SET SRCHK=0

                   End DoDot:1

 +6        QUIT