SRSCHOR.m

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

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