| 1 | SRSREQ ;BIR/MAM - MAKE REQUESTS ; [ 01/20/00 9:42 AM ]
|
|---|
| 2 | ;;3.0; Surgery ;**8,12,23,30,37,92,131,154**;24 Jun 93
|
|---|
| 3 | LOOP ; break procedure if greater than 70 characters
|
|---|
| 4 | 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
|
|---|
| 5 | Q
|
|---|
| 6 | CONCUR ; check for concurrent case
|
|---|
| 7 | 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
|
|---|
| 8 | Q:SRSCON=0
|
|---|
| 9 | 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=""
|
|---|
| 10 | 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)
|
|---|
| 11 | 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'."
|
|---|
| 12 | D ^DIR S SRSC=Y K DIR Q:$D(DUOUT)!$D(DTOUT) I 'Y K SRCTN Q
|
|---|
| 13 | ;if concurrent and the case is locked
|
|---|
| 14 | I Y,$D(^XTMP("SRLOCK-"_SRCTN)) D MSG^SRSUPRQ S SRSC=0 K SRCTN Q
|
|---|
| 15 | 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
|
|---|
| 16 | Q
|
|---|
| 17 | AVG ; update estimated case length
|
|---|
| 18 | 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
|
|---|
| 19 | 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
|
|---|
| 20 | G:X["^" AVG I X="@" S Y="@"
|
|---|
| 21 | S SRLNTH1=Y,DR="37///"_SRLNTH1,DIE=130,DA=SRTN D ^DIE K DR
|
|---|
| 22 | Q
|
|---|
| 23 | LATE ; check too see if it is too late to request
|
|---|
| 24 | I $D(^XUSEC("SR REQ OVERRIDE",DUZ)) Q
|
|---|
| 25 | 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
|
|---|
| 26 | 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
|
|---|
| 27 | 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
|
|---|
| 28 | .S DIC=40.5,DR="2",DA=SRHOL,DIQ="SRY",DIQ(0)="E" D EN^DIQ1 K DA,DIC,DIQ,DR
|
|---|
| 29 | .W !!,"Surgery requests not allowed for "_SRY(40.5,SRHOL,2,"E")_" !!"
|
|---|
| 30 | I '$D(SRSITE("REQ")) Q
|
|---|
| 31 | 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
|
|---|
| 32 | .K DIC S DIC=40.5,DIC(0)="XM" D ^DIC K DIC S SRHOL=$P(Y,"^")
|
|---|
| 33 | S SRTCHK=SRDTL_"."_SRSITE("REQ") D NOW^%DTC I %>SRTCHK S SRLATE=1
|
|---|
| 34 | I $D(SRLATE) D MESS
|
|---|
| 35 | Q
|
|---|
| 36 | NEXT ; find request cutoff for previous day
|
|---|
| 37 | 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
|
|---|
| 38 | Q
|
|---|
| 39 | MESS ; print message
|
|---|
| 40 | 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'.",!!
|
|---|
| 41 | PRESS W ! K DIR S DIR(0)="FOA",DIR("A")="Press RETURN to continue " D ^DIR K DIR
|
|---|
| 42 | Q
|
|---|
