- 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 Jan 18, 2025@03:48:52 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