SRSCHC.m

SRSCHC ;B'HAM ISC/MAM - SCHEDULE CONCURRENT CASES ; [ 09/22/98  11:50 AM ]

 ;;3.0; Surgery ;**67,50**;24 Jun 93

 W @IOF,! S (SRNOREQ,SRSCHD,SRSC1)=1,ST="SCHEDULING" D ^SRSDISP

 W ! K DIC S DIC="^SRS(",DIC(0)="QEAMZ",DIC("S")="I $$ORDIV^SROUTL0(+Y,$G(SRSITE(""DIV""))),('$P(^SRS(+Y,0),U,6))",DIC("A")="Schedule "_$S($D(SRSCON(2)):"these cases",1:"this case")_" for which Operating Room ?  " D ^DIC

 I Y<0 W !,"A case cannot be scheduled without selecting an operating room.",!!,"Press RETURN to continue  " R X:DTIME S SRSOUT=1 Q

 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="",Z="^" D ^SRSTIME I SRSOUT Q

 K SRGRPH,SRSDT3 S COUNT=1,MM=$E(SRSDT2,1,7),XX=$E(SRSDT1,1,7) I MM>XX S SRSDT3=MM,$P(SRSTIME,"^",2)="24:00"

GRPH I '$D(SRSTIME) Q

 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 H 1 S SRNOGO=1 Q

 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=$E(SRSDT1,1,7)

 S CON=0 F I=0:0 S CON=$O(SRSCON(CON)) Q:'CON  D SCH

 Q

SCH ; stuff scheduling info

 S SRTN=SRSCON(CON) K DR,DA S DIE=130,DA=SRTN,DR=".02////"_SRSOR_";Q;10////"_SRSDT1_";11////"_SRSDT2_";36////0;Q;.09///"_SRSDATE D ^DIE K DR

 S SRSOP=SRSCON(CON,"OP")

 S SROERR=SRTN D ^SROERR0

 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

SRSCHC    ;B'HAM ISC/MAM - SCHEDULE CONCURRENT CASES ; [ 09/22/98  11:50 AM ]

 +1       ;;3.0; Surgery ;**67,50**;24 Jun 93

 +2        WRITE @IOF,!

           SET (SRNOREQ,SRSCHD,SRSC1)=1

           SET ST="SCHEDULING"

           DO ^SRSDISP

 +3        WRITE !

           KILL DIC

           SET DIC="^SRS("

           SET DIC(0)="QEAMZ"

           SET DIC("S")="I $$ORDIV^SROUTL0(+Y,$G(SRSITE(""DIV""))),('$P(^SRS(+Y,0),U,6))"

           SET DIC("A")="Schedule "_$SELECT($DATA(SRSCON(2)):"these cases",1:"this case")_" for which Operating Room ?  "

           DO ^DIC

 +4        IF Y<0

               WRITE !,"A case cannot be scheduled without selecting an operating room.",!!,"Press RETURN to continue  "

               READ X:DTIME

               SET SRSOUT=1

               QUIT 

 +5        SET SRSOR=+Y

           SET X1=SRSDATE

           SET X2=2830103

           DO ^%DTC

           SET SRSDAY=$PIECE("MO^TU^WE^TH^FR^SA^SU","^",X#7+1)

 +6        SET (SRSOUT,SRSST,SRSET)=0

           SET P=""

           SET Z="^"

           DO ^SRSTIME

           IF SRSOUT

               QUIT 

 +7        KILL SRGRPH,SRSDT3

           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       IF '$DATA(SRSTIME)

               QUIT 

 +1        SET SRSST=$PIECE(SRSTIME,"^")

           SET SRSET=$PIECE(SRSTIME,"^",2)

           SET SRSST=$PIECE(SRSST,":")_"."_$PIECE(SRSST,":",2)

           SET SRSET=$PIECE(SRSET,":")_"."_$PIECE(SRSET,":",2)

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

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

           SET S="="

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

               HANG 1

               SET SRNOGO=1

               QUIT 

 +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=$EXTRACT(SRSDT1,1,7)

 +6        SET CON=0

           FOR I=0:0

               SET CON=$ORDER(SRSCON(CON))

               IF 'CON

                   QUIT 

               DO SCH

 +7        QUIT 

SCH       ; stuff scheduling info

 +1        SET SRTN=SRSCON(CON)

           KILL DR,DA

           SET DIE=130

           SET DA=SRTN

           SET DR=".02////"_SRSOR_";Q;10////"_SRSDT1_";11////"_SRSDT2_";36////0;Q;.09///"_SRSDATE

           DO ^DIE

           KILL DR

 +2        SET SRSOP=SRSCON(CON,"OP")

 +3        SET SROERR=SRTN

           DO ^SROERR0

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