SRSREQ ;BIR/MAM - MAKE REQUESTS ; [ 01/20/00 9:42 AM ]
;;3.0; Surgery ;**8,12,23,30,37,92,131,154**;24 Jun 93
LOOP ; break procedure if greater than 70 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)'<70 S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM
Q
CONCUR ; check for concurrent case
S (SRSCC,SRSCON)=0 F S SRSCC=$O(^SRF("AC",SRSDATE,SRSCC)) Q:'SRSCC I ^(SRSCC)=SRSDPT,$D(^SRF(SRSCC,"REQ")),$P(^("REQ"),"^")=1 S SRSCON=1 Q
Q:SRSCON=0
CC K SROPS,MM,MMM S SRCTN=SRSCC,SROPER=$P(^SRF(SRCTN,"OP"),"^") S:$L(SROPER)<70 SROPS(1)=SROPER I $L(SROPER)>69 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM=""
S DFN=SRSDPT D DEM^VADPT W !!,VADM(1)_" has the following procedure already entered for this",!,"date: ",!!,"CASE #"_SRCTN_" "_SROPS(1) I $D(SROPS(2)) W !,?9,SROPS(2) I $D(SROPS(3)) W !,?9,SROPS(3)
ASKCC K DIR W ! S DIR("A")="Will this be a concurrent procedure ",DIR("B")="NO",DIR(0)="Y",DIR("?",1)="If these procedures will be scheduled at the same time, in the same operating",DIR("?")="room, answer 'YES'."
D ^DIR S SRSC=Y K DIR Q:$D(DUOUT)!$D(DTOUT) I 'Y K SRCTN Q
;if concurrent and the case is locked
I Y,$D(^XTMP("SRLOCK-"_SRCTN)) D MSG^SRSUPRQ S SRSC=0 K SRCTN Q
S SRSCON(SRSCON,"OP")=$P(^SRF(SRCTN,"OP"),"^"),SRSCON(SRSCON,"DOC")=$P(^VA(200,$P(^SRF(SRCTN,.1),"^",4),0),"^"),SRSCON(SRSCON,"SS")=$P(^SRO(137.45,$P(^SRF(SRCTN,0),"^",4),0),"^"),SRSCON(SRSCON)=SRCTN
Q
AVG ; update estimated case length
S SRAVG="",SRSPEC=$P(^SRF(SRTN,0),"^",4),SRSCPT=$P(^SRF(SRTN,"OP"),"^",2) D ^SRSAVG S SRLNTH=$P($G(^SRF(SRTN,.4)),"^") I SRLNTH="" S SRLNTH=SRAVG
W ! K DIR S DIR("A")="How long is this procedure ? (HOURS:MINUTES) ",DIR("B")=SRLNTH,DIR(0)="130,37A" D ^DIR I $D(DUOUT)!$D(DTOUT) Q
G:X["^" AVG I X="@" S Y="@"
S SRLNTH1=Y,DR="37///"_SRLNTH1,DIE=130,DA=SRTN D ^DIE K DR
Q
LATE ; check too see if it is too late to request
I $D(^XUSEC("SR REQ OVERRIDE",DUZ)) Q
N SRHOL,SRXDT S SRHOL="",(SRXDT,X)=SRSDATE D H^%DTC S SRDAY=%Y+1 S SRDL=$P($G(^SRO(133,SRSITE,2)),"^",SRDAY) S:SRDL="" SRDL=1
I 'SRDL W !!,"Surgery requests not allowed for "_$S(SRDAY=1:"SUN",SRDAY=2:"MON",SRDAY=3:"TUES",SRDAY=4:"WEDNES",SRDAY=5:"THURS",SRDAY=6:"FRI",1:"SATUR")_"DAY !!",! D PRESS S SRLATE=1 Q
K DIC S DIC=40.5,DIC(0)="XM",X=SRSDATE D ^DIC K DIC S SRHOL=$P(Y,"^") I SRHOL>0,'$D(^SRO(133,SRSITE,3,SRSDATE,0)) D S SRLATE=1 D PRESS Q
.S DIC=40.5,DR="2",DA=SRHOL,DIQ="SRY",DIQ(0)="E" D EN^DIQ1 K DA,DIC,DIQ,DR
.W !!,"Surgery requests not allowed for "_SRY(40.5,SRHOL,2,"E")_" !!"
I '$D(SRSITE("REQ")) Q
F S X1=SRXDT,X2=-SRDL D C^%DTC S SRDTL=X D Q:SRHOL'>0!$D(^SRO(133,SRSITE,3,X,0)) D NEXT
.K DIC S DIC=40.5,DIC(0)="XM" D ^DIC K DIC S SRHOL=$P(Y,"^")
S SRTCHK=SRDTL_"."_SRSITE("REQ") D NOW^%DTC I %>SRTCHK S SRLATE=1
I $D(SRLATE) D MESS
Q
NEXT ; find request cutoff for previous day
S X1=SRXDT,X2=-1 D C^%DTC S SRXDT=X D H^%DTC S SRDAY=%Y+1 S SRDL=$P($G(^SRO(133,SRSITE,2)),"^",SRDAY) S:SRDL="" SRDL=1 I SRDL=0 D NEXT
Q
MESS ; print message
W !!,"I'm sorry, but it is too late to make a request. If this case must",!,"be entered, use the option 'Schedule Unrequested Operations' under",!,"the 'Schedule Operations Menu'.",!!
PRESS W ! K DIR S DIR(0)="FOA",DIR("A")="Press RETURN to continue " D ^DIR K DIR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRSREQ 3325 printed Sep 23, 2025@20:24:08 Page 2
SRSREQ ;BIR/MAM - MAKE REQUESTS ; [ 01/20/00 9:42 AM ]
+1 ;;3.0; Surgery ;**8,12,23,30,37,92,131,154**;24 Jun 93
LOOP ; break procedure if greater than 70 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)'<70
QUIT
SET SROPS(M)=SROPS(M)_MM_" "
SET SROPER=MMM
+2 QUIT
CONCUR ; check for concurrent case
+1 SET (SRSCC,SRSCON)=0
FOR
SET SRSCC=$ORDER(^SRF("AC",SRSDATE,SRSCC))
if 'SRSCC
QUIT
IF ^(SRSCC)=SRSDPT
IF $DATA(^SRF(SRSCC,"REQ"))
IF $PIECE(^("REQ"),"^")=1
SET SRSCON=1
QUIT
+2 if SRSCON=0
QUIT
CC KILL SROPS,MM,MMM
SET SRCTN=SRSCC
SET SROPER=$PIECE(^SRF(SRCTN,"OP"),"^")
if $LENGTH(SROPER)<70
SET SROPS(1)=SROPER
IF $LENGTH(SROPER)>69
SET SROPER=SROPER_" "
FOR M=1:1
DO LOOP
if MMM=""
QUIT
+1 SET DFN=SRSDPT
DO DEM^VADPT
WRITE !!,VADM(1)_" has the following procedure already entered for this",!,"date: ",!!,"CASE #"_SRCTN_" "_SROPS(1)
IF $DATA(SROPS(2))
WRITE !,?9,SROPS(2)
IF $DATA(SROPS(3))
WRITE !,?9,SROPS(3)
ASKCC KILL DIR
WRITE !
SET DIR("A")="Will this be a concurrent procedure "
SET DIR("B")="NO"
SET DIR(0)="Y"
SET DIR("?",1)="If these procedures will be scheduled at the same time, in the same operating"
SET DIR("?")="room, answer 'YES'."
+1 DO ^DIR
SET SRSC=Y
KILL DIR
if $DATA(DUOUT)!$DATA(DTOUT)
QUIT
IF 'Y
KILL SRCTN
QUIT
+2 ;if concurrent and the case is locked
+3 IF Y
IF $DATA(^XTMP("SRLOCK-"_SRCTN))
DO MSG^SRSUPRQ
SET SRSC=0
KILL SRCTN
QUIT
+4 SET SRSCON(SRSCON,"OP")=$PIECE(^SRF(SRCTN,"OP"),"^")
SET SRSCON(SRSCON,"DOC")=$PIECE(^VA(200,$PIECE(^SRF(SRCTN,.1),"^",4),0),"^")
SET SRSCON(SRSCON,"SS")=$PIECE(^SRO(137.45,$PIECE(^SRF(SRCTN,0),"^",4),0),"^")
SET SRSCON(SRSCON)=SRCTN
+5 QUIT
AVG ; update estimated case length
+1 SET SRAVG=""
SET SRSPEC=$PIECE(^SRF(SRTN,0),"^",4)
SET SRSCPT=$PIECE(^SRF(SRTN,"OP"),"^",2)
DO ^SRSAVG
SET SRLNTH=$PIECE($GET(^SRF(SRTN,.4)),"^")
IF SRLNTH=""
SET SRLNTH=SRAVG
+2 WRITE !
KILL DIR
SET DIR("A")="How long is this procedure ? (HOURS:MINUTES) "
SET DIR("B")=SRLNTH
SET DIR(0)="130,37A"
DO ^DIR
IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+3 if X["^"
GOTO AVG
IF X="@"
SET Y="@"
+4 SET SRLNTH1=Y
SET DR="37///"_SRLNTH1
SET DIE=130
SET DA=SRTN
DO ^DIE
KILL DR
+5 QUIT
LATE ; check too see if it is too late to request
+1 IF $DATA(^XUSEC("SR REQ OVERRIDE",DUZ))
QUIT
+2 NEW SRHOL,SRXDT
SET SRHOL=""
SET (SRXDT,X)=SRSDATE
DO H^%DTC
SET SRDAY=%Y+1
SET SRDL=$PIECE($GET(^SRO(133,SRSITE,2)),"^",SRDAY)
if SRDL=""
SET SRDL=1
+3 IF 'SRDL
WRITE !!,"Surgery requests not allowed for "_$SELECT(SRDAY=1:"SUN",SRDAY=2:"MON",SRDAY=3:"TUES",SRDAY=4:"WEDNES",SRDAY=5:"THURS",SRDAY=6:"FRI",1:"SATUR")_"DAY !!",!
DO PRESS
SET SRLATE=1
QUIT
+4 KILL DIC
SET DIC=40.5
SET DIC(0)="XM"
SET X=SRSDATE
DO ^DIC
KILL DIC
SET SRHOL=$PIECE(Y,"^")
IF SRHOL>0
IF '$DATA(^SRO(133,SRSITE,3,SRSDATE,0))
Begin DoDot:1
+5 SET DIC=40.5
SET DR="2"
SET DA=SRHOL
SET DIQ="SRY"
SET DIQ(0)="E"
DO EN^DIQ1
KILL DA,DIC,DIQ,DR
+6 WRITE !!,"Surgery requests not allowed for "_SRY(40.5,SRHOL,2,"E")_" !!"
End DoDot:1
SET SRLATE=1
DO PRESS
QUIT
+7 IF '$DATA(SRSITE("REQ"))
QUIT
+8 FOR
SET X1=SRXDT
SET X2=-SRDL
DO C^%DTC
SET SRDTL=X
Begin DoDot:1
+9 KILL DIC
SET DIC=40.5
SET DIC(0)="XM"
DO ^DIC
KILL DIC
SET SRHOL=$PIECE(Y,"^")
End DoDot:1
if SRHOL'>0!$DATA(^SRO(133,SRSITE,3,X,0))
QUIT
DO NEXT
+10 SET SRTCHK=SRDTL_"."_SRSITE("REQ")
DO NOW^%DTC
IF %>SRTCHK
SET SRLATE=1
+11 IF $DATA(SRLATE)
DO MESS
+12 QUIT
NEXT ; find request cutoff for previous day
+1 SET X1=SRXDT
SET X2=-1
DO C^%DTC
SET SRXDT=X
DO H^%DTC
SET SRDAY=%Y+1
SET SRDL=$PIECE($GET(^SRO(133,SRSITE,2)),"^",SRDAY)
if SRDL=""
SET SRDL=1
IF SRDL=0
DO NEXT
+2 QUIT
MESS ; print message
+1 WRITE !!,"I'm sorry, but it is too late to make a request. If this case must",!,"be entered, use the option 'Schedule Unrequested Operations' under",!,"the 'Schedule Operations Menu'.",!!
PRESS WRITE !
KILL DIR
SET DIR(0)="FOA"
SET DIR("A")="Press RETURN to continue "
DO ^DIR
KILL DIR
+1 QUIT
