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