- SRSCHOR ;B'HAM ISC/ADM - SCHEDULE OPERATING ROOM; 23 Oct 1992 9:05 AM
- ;;3.0; Surgery ;**37**;24 Jun 93
- DISP S SRNOREQ=1 D ^SRSDISP Q:SRSOUT
- ROOM W ! K DIR S DIR(0)="130,.02A",DIR("A")="Schedule a case for which operating Room ? " D ^DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q
- I Y="" W !!,"To schedule a case an operating room MUST be selected. Enter '^' to exit.",! G ROOM
- S SRSOR=+Y,X1=SRSDATE,X2=2830103 D ^%DTC S SRSDAY=$P("MO^TU^WE^TH^FR^SA^SU","^",X#7+1)
- S (SRSOUT,SRSST,SRSET)=0,P=""
- S Z="^" D ^SRSTIME I SRSOUT Q
- K SRGRPH,SRSDT3 S SRSAVE=SRSDATE,COUNT=1,MM=$E(SRSDT2,1,7),XX=$E(SRSDT1,1,7) I MM>XX S SRSDT3=MM,$P(SRSTIME,"^",2)="24:00"
- GRPH S SRSST=$P(SRSTIME,"^"),SRSET=$P(SRSTIME,"^",2),SRSST=$P(SRSST,":")_"."_$P(SRSST,":",2),SRSET=$P(SRSET,":")_"."_$P(SRSET,":",2)
- S SRS1=11+($P(SRSST,".")*5)+(SRSST-$P(SRSST,".")*100\15),SRS2=11+($P(SRSET,".")*5)+(SRSET-$P(SRSET,".")*100\15),S="="
- F I=SRS1+1:1:SRS2-1 S S=S_$S('(I#5):"|",1:"X")
- PATRN ; set up pattern
- I $E(^SRS(SRSOR,"S",SRSDATE,1),SRS1+1,SRS2)["X"!($E(^SRS(SRSOR,"S",SRSDATE,1),SRS1+1,SRS2)["=") D LAP G DISP
- S SRGRPH(COUNT)=SRSDATE_"^"_SRS1_"^"_SRS2_"^"_S,COUNT=COUNT+1
- I $D(SRSDT3) S SRSTIME="00:00^"_SRSET1,SRSDATE=SRSDT3 K SRSDT3 G GRPH
- F COUNT=1,2 I $D(SRGRPH(COUNT)) S SRSDATE=$P(SRGRPH(COUNT),"^"),SRS1=$P(SRGRPH(COUNT),"^",2),SRS2=$P(SRGRPH(COUNT),"^",3),S=$P(SRGRPH(COUNT),"^",4) D ^SRSGRPH
- S SRSDATE=SRSAVE
- Q
- LAP W !!,"Overlapping reservations on "_$E(SRSDATE,4,5)_"/"_$E(SRSDATE,6,7)_"/"_$E(SRSDATE,2,3)_". This case cannot be scheduled."
- W !!,"Press RETURN to continue " R X:DTIME
- Q
- DW Q:'SRSDATE S X1=SRSDATE,X2=2830103 D ^%DTC S SRSDAY=$P("MO^TU^WE^TH^FR^SA^SU","^",X#7+1) Q
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRSCHOR 1698 printed Feb 19, 2025@00:13:47 Page 2
- SRSCHOR ;B'HAM ISC/ADM - SCHEDULE OPERATING ROOM; 23 Oct 1992 9:05 AM
- +1 ;;3.0; Surgery ;**37**;24 Jun 93
- DISP SET SRNOREQ=1
- DO ^SRSDISP
- if SRSOUT
- QUIT
- ROOM WRITE !
- KILL DIR
- SET DIR(0)="130,.02A"
- SET DIR("A")="Schedule a case for which operating Room ? "
- DO ^DIR
- IF $DATA(DTOUT)!$DATA(DUOUT)
- SET SRSOUT=1
- QUIT
- +1 IF Y=""
- WRITE !!,"To schedule a case an operating room MUST be selected. Enter '^' to exit.",!
- GOTO ROOM
- +2 SET SRSOR=+Y
- SET X1=SRSDATE
- SET X2=2830103
- DO ^%DTC
- SET SRSDAY=$PIECE("MO^TU^WE^TH^FR^SA^SU","^",X#7+1)
- +3 SET (SRSOUT,SRSST,SRSET)=0
- SET P=""
- +4 SET Z="^"
- DO ^SRSTIME
- IF SRSOUT
- QUIT
- +5 KILL SRGRPH,SRSDT3
- SET SRSAVE=SRSDATE
- SET COUNT=1
- SET MM=$EXTRACT(SRSDT2,1,7)
- SET XX=$EXTRACT(SRSDT1,1,7)
- IF MM>XX
- SET SRSDT3=MM
- SET $PIECE(SRSTIME,"^",2)="24:00"
- GRPH SET SRSST=$PIECE(SRSTIME,"^")
- SET SRSET=$PIECE(SRSTIME,"^",2)
- SET SRSST=$PIECE(SRSST,":")_"."_$PIECE(SRSST,":",2)
- SET SRSET=$PIECE(SRSET,":")_"."_$PIECE(SRSET,":",2)
- +1 SET SRS1=11+($PIECE(SRSST,".")*5)+(SRSST-$PIECE(SRSST,".")*100\15)
- SET SRS2=11+($PIECE(SRSET,".")*5)+(SRSET-$PIECE(SRSET,".")*100\15)
- SET S="="
- +2 FOR I=SRS1+1:1:SRS2-1
- SET S=S_$SELECT('(I#5):"|",1:"X")
- PATRN ; set up pattern
- +1 IF $EXTRACT(^SRS(SRSOR,"S",SRSDATE,1),SRS1+1,SRS2)["X"!($EXTRACT(^SRS(SRSOR,"S",SRSDATE,1),SRS1+1,SRS2)["=")
- DO LAP
- GOTO DISP
- +2 SET SRGRPH(COUNT)=SRSDATE_"^"_SRS1_"^"_SRS2_"^"_S
- SET COUNT=COUNT+1
- +3 IF $DATA(SRSDT3)
- SET SRSTIME="00:00^"_SRSET1
- SET SRSDATE=SRSDT3
- KILL SRSDT3
- GOTO GRPH
- +4 FOR COUNT=1,2
- IF $DATA(SRGRPH(COUNT))
- SET SRSDATE=$PIECE(SRGRPH(COUNT),"^")
- SET SRS1=$PIECE(SRGRPH(COUNT),"^",2)
- SET SRS2=$PIECE(SRGRPH(COUNT),"^",3)
- SET S=$PIECE(SRGRPH(COUNT),"^",4)
- DO ^SRSGRPH
- +5 SET SRSDATE=SRSAVE
- +6 QUIT
- LAP WRITE !!,"Overlapping reservations on "_$EXTRACT(SRSDATE,4,5)_"/"_$EXTRACT(SRSDATE,6,7)_"/"_$EXTRACT(SRSDATE,2,3)_". This case cannot be scheduled."
- +1 WRITE !!,"Press RETURN to continue "
- READ X:DTIME
- +2 QUIT
- DW if 'SRSDATE
- QUIT
- SET X1=SRSDATE
- SET X2=2830103
- DO ^%DTC
- SET SRSDAY=$PIECE("MO^TU^WE^TH^FR^SA^SU","^",X#7+1)
- QUIT
- +1 QUIT