- SRSCHD2 ;B'HAM ISC/MAM - SCHEDULE REQUESTED CASES ; [ 09/22/98 11:51 AM ]
- ;;3.0; Surgery ;**3,19,67,41,50,114**;24 Jun 93
- ROOM ; display graph, select room
- S SRSOUT=0 D ^SRSTCH I SRSOUT Q
- D ^SRSDISP I SRSOUT Q
- 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 a Case for which Operating Room ? " D ^DIC I Y<0 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=0,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 Q:'$D(SRSTIME)
- EN2 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 S SRSLAP=1 Q:$D(SRSUPDT) Q
- I $G(SRSLAP)'=1 D HL7RS
- 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)
- SRF ;
- S SRNOCON=1 K DR I '$D(SRSCC) W !! S SR(.3)=$G(^SRF(SRTN,.3)),SRSA=$P(SR(.3),"^"),SRSAS=$P(SR(.3),"^",4),DA=SRTN,DIE=130,DR=".31T;.34T" D ^DIE K DR
- I $D(SRSCC) S OTHER=$P(^SRF(SRTN,"CON"),"^"),SR(.3)=$G(^SRF(OTHER,.3)),SRSA=$P(SR(.3),"^"),SRSAS=$P(SR(.3),"^",4),DA=SRTN,DIE=130,DR=".31////"_SRSA_";.34////"_SRSAS D ^DIE K DR
- ;S:$P(SRSDT1,".",2)="" SRSDT1=SRSDT1_".0000"
- K DR S DA=SRTN,DIE=130,DR=".02////"_SRSOR_";10////"_SRSDT1_";11////"_SRSDT2_";Q;36////0;Q;.09////"_SRSDATE D ^DIE
- D HL7
- CC I '$D(SRSCC),$D(^SRF(SRTN,"CON")),$P(^("CON"),"^")'="" D CONCRNT^SRSUTL I SRBOTH=1 D HL7RS G SRF
- Q:$D(SRUPDT) K SRSCC W @IOF Q
- LOOP ; break procedure if greater than 75 characters
- S SROPS(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM="" Q:$L(SROPS(M))+$L(MM)'<75 S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM
- 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
- HL7 ;check for case modification
- I '$D(SRTN("OR"))!('$D(^SRF(SRTN,.3))) S SROERR=SRTN D ^SROERR0 Q
- I $G(SRTN("OR"))'=$G(SRSOR)!($G(SRSA)'=$P(^SRF(SRTN,.3),"^"))!($G(SRSAS)'=$P(^SRF(SRTN,.3),"^",4)) S SROERR=SRTN D ^SROERR0
- Q
- HL7RS ;check for case reschedule
- Q:'$D(SRTN("START"))
- I $G(SRTN("START"))'=$G(SRSDT1)!($G(SRTN("END"))'=$G(SRSDT2))!($G(SRSDATE)'=$G(OLDATE)) K DR S DA=SRTN,DIE=130,DR="10////"_SRSDT1_";11////"_SRSDT2 D ^DIE K DR D
- .N SREVENT S SREVENT="S13" K SRSTATUS S SROERR=SRTN D STATUS^SROERR0,MSG^SRHLZIU(SRTN,SRSTATUS,SREVENT)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRSCHD2 3177 printed Feb 19, 2025@00:13:43 Page 2
- SRSCHD2 ;B'HAM ISC/MAM - SCHEDULE REQUESTED CASES ; [ 09/22/98 11:51 AM ]
- +1 ;;3.0; Surgery ;**3,19,67,41,50,114**;24 Jun 93
- ROOM ; display graph, select room
- +1 SET SRSOUT=0
- DO ^SRSTCH
- IF SRSOUT
- QUIT
- +2 DO ^SRSDISP
- IF SRSOUT
- QUIT
- +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 a Case for which Operating Room ? "
- DO ^DIC
- IF Y<0
- SET SRSOUT=1
- QUIT
- +4 SET SRSOR=+Y
- SET X1=SRSDATE
- SET X2=2830103
- DO ^%DTC
- SET SRSDAY=$PIECE("MO^TU^WE^TH^FR^SA^SU","^",X#7+1)
- +5 SET SRSOUT=0
- SET Z="^"
- DO ^SRSTIME
- IF SRSOUT
- QUIT
- +6 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
- EN2 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
- SET SRSLAP=1
- if $DATA(SRSUPDT)
- QUIT
- QUIT
- +2 IF $GET(SRSLAP)'=1
- DO HL7RS
- +3 SET SRGRPH(COUNT)=SRSDATE_"^"_SRS1_"^"_SRS2_"^"_S
- SET COUNT=COUNT+1
- +4 IF $DATA(SRSDT3)
- SET SRSTIME="00:00^"_SRSET1
- SET SRSDATE=SRSDT3
- KILL SRSDT3
- GOTO GRPH
- +5 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
- +6 SET SRSDATE=$EXTRACT(SRSDT1,1,7)
- SRF ;
- +1 SET SRNOCON=1
- KILL DR
- IF '$DATA(SRSCC)
- WRITE !!
- SET SR(.3)=$GET(^SRF(SRTN,.3))
- SET SRSA=$PIECE(SR(.3),"^")
- SET SRSAS=$PIECE(SR(.3),"^",4)
- SET DA=SRTN
- SET DIE=130
- SET DR=".31T;.34T"
- DO ^DIE
- KILL DR
- +2 IF $DATA(SRSCC)
- SET OTHER=$PIECE(^SRF(SRTN,"CON"),"^")
- SET SR(.3)=$GET(^SRF(OTHER,.3))
- SET SRSA=$PIECE(SR(.3),"^")
- SET SRSAS=$PIECE(SR(.3),"^",4)
- SET DA=SRTN
- SET DIE=130
- SET DR=".31////"_SRSA_";.34////"_SRSAS
- DO ^DIE
- KILL DR
- +3 ;S:$P(SRSDT1,".",2)="" SRSDT1=SRSDT1_".0000"
- +4 KILL DR
- SET DA=SRTN
- SET DIE=130
- SET DR=".02////"_SRSOR_";10////"_SRSDT1_";11////"_SRSDT2_";Q;36////0;Q;.09////"_SRSDATE
- DO ^DIE
- +5 DO HL7
- CC IF '$DATA(SRSCC)
- IF $DATA(^SRF(SRTN,"CON"))
- IF $PIECE(^("CON"),"^")'=""
- DO CONCRNT^SRSUTL
- IF SRBOTH=1
- DO HL7RS
- GOTO SRF
- +1 if $DATA(SRUPDT)
- QUIT
- KILL SRSCC
- WRITE @IOF
- QUIT
- LOOP ; break procedure if greater than 75 characters
- +1 SET SROPS(M)=""
- FOR LOOP=1:1
- SET MM=$PIECE(SROPER," ")
- SET MMM=$PIECE(SROPER," ",2,200)
- if MMM=""
- QUIT
- if $LENGTH(SROPS(M))+$LENGTH(MM)'<75
- QUIT
- SET SROPS(M)=SROPS(M)_MM_" "
- SET SROPER=MMM
- +2 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
- HL7 ;check for case modification
- +1 IF '$DATA(SRTN("OR"))!('$DATA(^SRF(SRTN,.3)))
- SET SROERR=SRTN
- DO ^SROERR0
- QUIT
- +2 IF $GET(SRTN("OR"))'=$GET(SRSOR)!($GET(SRSA)'=$PIECE(^SRF(SRTN,.3),"^"))!($GET(SRSAS)'=$PIECE(^SRF(SRTN,.3),"^",4))
- SET SROERR=SRTN
- DO ^SROERR0
- +3 QUIT
- HL7RS ;check for case reschedule
- +1 if '$DATA(SRTN("START"))
- QUIT
- +2 IF $GET(SRTN("START"))'=$GET(SRSDT1)!($GET(SRTN("END"))'=$GET(SRSDT2))!($GET(SRSDATE)'=$GET(OLDATE))
- KILL DR
- SET DA=SRTN
- SET DIE=130
- SET DR="10////"_SRSDT1_";11////"_SRSDT2
- DO ^DIE
- KILL DR
- Begin DoDot:1
- +3 NEW SREVENT
- SET SREVENT="S13"
- KILL SRSTATUS
- SET SROERR=SRTN
- DO STATUS^SROERR0
- DO MSG^SRHLZIU(SRTN,SRSTATUS,SREVENT)
- End DoDot:1
- +4 QUIT