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 Apr 09, 2024@21:41:46 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
