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 ---[H[J[2J[HSRSBD1 662 printed Dec 13, 2024@02:46:53 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
