SRORUT0 ;B'HAM ISC/MAM - OR UTILIZATION ; [ 10/01/98 9:55 AM ]
;;3.0; Surgery ;**34,50**;24 Jun 93
EN ; entry when queued
K ^TMP("SR",$J) S SRSOUT=0,SRFLG=1,SRSDT=SRSD1,^TMP("SR",$J)="0^0^0^0"
I SROR="ALL" S SRFLG=0 D ALL^SROUTIN S SROR=0 F S SROR=$O(^SRF("AOR",SROR)) Q:'SROR I $$ORDIV^SROUTL0(SROR,SRDIV),'$P(^SRS(SROR,0),"^",6) S SRSDT=SRSD1 D AOR
I SRFLG S (X,SRSDATE)=SRSD D H^%DTC S SRD=%Y D ONE^SROUTIN,AOR
MM U IO N SRFRTO S Y=SRSD X ^DD("DD") S SRFRTO=" FROM: "_Y_" TO: ",Y=SRED X ^DD("DD") S SRFRTO=SRFRTO_Y,Y=DT X ^DD("DD") S SRPRINT="DATE PRINTED: "_Y
I SRFLG S SRORN=$P(^SRS(SROR,0),"^"),SRORN=$P(^SC(SRORN,0),"^")
S SRHDR="FOR "_$S($D(SRORN):SRORN,1:"ALL OPERATING ROOMS")_SRFRTO,PAGE=0
D ^SRORUT1
END W:$E(IOST)="P" @IOF I $D(ZTQUEUED) K ^TMP("SR",$J) Q:$G(ZTSTOP) S ZTREQ="@" Q
D ^SRSKILL K SRTN D ^%ZISC W @IOF
Q
AOR ;
F K ^TMP("SRPAT",$J) S SRSDT=$O(^SRF("AOR",SROR,SRSDT)) Q:'SRSDT!(SRSDT>SRED1) D DAY S SRTN=0 F S SRTN=$O(^SRF("AOR",SROR,SRSDT,SRTN)) Q:'SRTN D UTIL
Q
DAY ; get start times
S TIMES=$P(^TMP("SR",$J,SRSDT,SROR),"^",5,6),SRORST=$P(TIMES,"^"),SROREND=$P(TIMES,"^",2),SRTIME=1
S X=$P(SRORST,".",2) S:'X SRTIME="" S X=$P(SROREND,".",2) S:'X SRTIME=""
Q
UTIL ; set ^TMP("SR"
S SRCON=$P($G(^SRF(SRTN,"CON")),"^") I SRCON,$D(^TMP("SR",$J,"OR",SROR,SRCON)) D CON Q
S SR(.2)=$S($D(^SRF(SRTN,.2)):^(.2),1:"") Q:SR(.2)="" S SRPATIN=$P(SR(.2),"^",10),SRPATOUT=$P(SR(.2),"^",12),SRNURSE=$P(SR(.2),"^",7)
S DFN=$P(^SRF(SRTN,0),"^") I $D(^TMP("SRPAT",$J,SRSDT,DFN)) D OPCHK I SRCON D CON Q
I SRPATIN="",SRNURSE="" Q
Q:SRPATOUT="" S TIMEOUT=SRPATOUT S:SRPATIN="" SRPATIN=99999999 S:SRNURSE="" SRNURSE=99999999 S TIMEIN=$S(SRPATIN<SRNURSE:SRPATIN,1:SRNURSE) D ET
S X1=TIMEOUT,X=TIMEIN D MIN S SROPTIME=X D OT
S SRUTIL=^TMP("SR",$J,SRSDT,SROR),SRT=$P(SRUTIL,"^",5,6),SRCASE=$P(SRUTIL,"^")+1
S SROPDT=$P(SRUTIL,"^",2)+SROPTIME,SRTP=$P(SRUTIL,"^",3),SROT=$P(SRUTIL,"^",4)+SROVRT,^TMP("SR",$J,SRSDT,SROR)=SRCASE_"^"_SROPDT_"^"_SRTP_"^"_SROT_"^"_SRT
S SRUTIL=^TMP("SR",$J,SRSDT),SRCASE=$P(SRUTIL,"^")+1,SROPDT=$P(SRUTIL,"^",2)+SROPTIME,SROT=$P(SRUTIL,"^",4)+SROVRT,^TMP("SR",$J,SRSDT)=SRCASE_"^"_SROPDT_"^"_$P(SRUTIL,"^",3)_"^"_SROT_"^"_$P(SRUTIL,"^",5)
S SRUTIL=^TMP("SR",$J),SRCASE=$P(SRUTIL,"^")+1,SROPDT=$P(SRUTIL,"^",2)+SROPTIME,SRTP=$P(SRUTIL,"^",3),SROT=$P(SRUTIL,"^",4)+SROVRT,^TMP("SR",$J)=SRCASE_"^"_SROPDT_"^"_SRTP_"^"_SROT
S SRUTIL=^TMP("SR",$J,"OR",SROR),SRCASE=$P(SRUTIL,"^")+1,SROPDT=$P(SRUTIL,"^",2)+SROPTIME,SRTP=$P(SRUTIL,"^",3),SROT=$P(SRUTIL,"^",4)+SROVRT,^TMP("SR",$J,"OR",SROR)=SRCASE_"^"_SROPDT_"^"_SRTP_"^"_SROT
S ^TMP("SR",$J,"OR",SROR,SRTN)="",^TMP("SRPAT",$J,SRSDT,DFN)=SROR_"^"_SRPATIN_"^"_SRPATOUT
Q
OT ; calculate overtime
S SROVRT=0
I 'SRTIME S X=TIMEIN,X1=TIMEOUT D MIN S SROVRT=X
I TIMEOUT<SRORST S X=TIMEIN,X1=TIMEOUT D MIN S SROVRT=X Q
I TIMEIN>SROREND S X=TIMEIN,X1=TIMEOUT D MIN S SROVRT=X Q
I TIMEIN<SRORST S X=TIMEIN,X1=SRORST D MIN S SROVRT=X
I TIMEOUT>SROREND S X=SROREND,X1=TIMEOUT D MIN S SROVRT=SROVRT+X
Q
MIN ; minutes between two times
S Y=$E(X1_"000",9,10)-$E(X_"000",9,10)*60+$E(X1_"00000",11,12)-$E(X_"00000",11,12),X2=X,X=$P(X,".",1)'=$P(X1,".",1) D ^%DTC:X S X=X*1440+Y
Q
CON S $P(^TMP("SR",$J,SRSDT,SROR),"^")=$P(^TMP("SR",$J,SRSDT,SROR),"^")+1
S $P(^TMP("SR",$J,SRSDT),"^")=$P(^TMP("SR",$J,SRSDT),"^")+1
S $P(^TMP("SR",$J),"^")=$P(^TMP("SR",$J),"^")+1
S $P(^TMP("SR",$J,"OR",SROR),"^")=$P(^TMP("SR",$J,"OR",SROR),"^")+1
S ^TMP("SR",$J,"OR",SROR,SRTN)=""
Q
ET ; add cleanup time to time out of O.R.
S CLEAN=$S($D(^SRS(SROR,3)):+^(3),1:30),SRD=$E(TIMEOUT,1,7),SRT=$P(TIMEOUT,".",2)_"0000",SRMIN=$E(SRT,3,4),SRHR=$E(SRT,1,2)
S SRMIN=SRMIN+CLEAN I SRMIN>59 S SRHR=SRHR+(SRMIN\60) S SRMIN=SRMIN#60 I SRHR>23 S X1=SRD,X2=1 D C^%DTC S SRD=X,SRHR="00"
S:$L(SRHR)=1 SRHR="0"_SRHR S:$L(SRMIN)=1 SRMIN="0"_SRMIN S TIMEOUT=SRD_"."_SRHR_SRMIN
Q
OPCHK ; check for concurrent case not marked conurrent
S X=^TMP("SRPAT",$J,SRSDT,DFN),SRRM=$P(X,"^"),SRIN=$P(X,"^",2),SROUT=$P(X,"^",3) Q:SRRM'=SROR
I SRIN=SRPATIN,SROUT=SRPATOUT S SRCON=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRORUT0 4108 printed Dec 13, 2024@02:45:56 Page 2
SRORUT0 ;B'HAM ISC/MAM - OR UTILIZATION ; [ 10/01/98 9:55 AM ]
+1 ;;3.0; Surgery ;**34,50**;24 Jun 93
EN ; entry when queued
+1 KILL ^TMP("SR",$JOB)
SET SRSOUT=0
SET SRFLG=1
SET SRSDT=SRSD1
SET ^TMP("SR",$JOB)="0^0^0^0"
+2 IF SROR="ALL"
SET SRFLG=0
DO ALL^SROUTIN
SET SROR=0
FOR
SET SROR=$ORDER(^SRF("AOR",SROR))
if 'SROR
QUIT
IF $$ORDIV^SROUTL0(SROR,SRDIV)
IF '$PIECE(^SRS(SROR,0),"^",6)
SET SRSDT=SRSD1
DO AOR
+3 IF SRFLG
SET (X,SRSDATE)=SRSD
DO H^%DTC
SET SRD=%Y
DO ONE^SROUTIN
DO AOR
MM USE IO
NEW SRFRTO
SET Y=SRSD
XECUTE ^DD("DD")
SET SRFRTO=" FROM: "_Y_" TO: "
SET Y=SRED
XECUTE ^DD("DD")
SET SRFRTO=SRFRTO_Y
SET Y=DT
XECUTE ^DD("DD")
SET SRPRINT="DATE PRINTED: "_Y
+1 IF SRFLG
SET SRORN=$PIECE(^SRS(SROR,0),"^")
SET SRORN=$PIECE(^SC(SRORN,0),"^")
+2 SET SRHDR="FOR "_$SELECT($DATA(SRORN):SRORN,1:"ALL OPERATING ROOMS")_SRFRTO
SET PAGE=0
+3 DO ^SRORUT1
END if $EXTRACT(IOST)="P"
WRITE @IOF
IF $DATA(ZTQUEUED)
KILL ^TMP("SR",$JOB)
if $GET(ZTSTOP)
QUIT
SET ZTREQ="@"
QUIT
+1 DO ^SRSKILL
KILL SRTN
DO ^%ZISC
WRITE @IOF
+2 QUIT
AOR ;
+1 FOR
KILL ^TMP("SRPAT",$JOB)
SET SRSDT=$ORDER(^SRF("AOR",SROR,SRSDT))
if 'SRSDT!(SRSDT>SRED1)
QUIT
DO DAY
SET SRTN=0
FOR
SET SRTN=$ORDER(^SRF("AOR",SROR,SRSDT,SRTN))
if 'SRTN
QUIT
DO UTIL
+2 QUIT
DAY ; get start times
+1 SET TIMES=$PIECE(^TMP("SR",$JOB,SRSDT,SROR),"^",5,6)
SET SRORST=$PIECE(TIMES,"^")
SET SROREND=$PIECE(TIMES,"^",2)
SET SRTIME=1
+2 SET X=$PIECE(SRORST,".",2)
if 'X
SET SRTIME=""
SET X=$PIECE(SROREND,".",2)
if 'X
SET SRTIME=""
+3 QUIT
UTIL ; set ^TMP("SR"
+1 SET SRCON=$PIECE($GET(^SRF(SRTN,"CON")),"^")
IF SRCON
IF $DATA(^TMP("SR",$JOB,"OR",SROR,SRCON))
DO CON
QUIT
+2 SET SR(.2)=$SELECT($DATA(^SRF(SRTN,.2)):^(.2),1:"")
if SR(.2)=""
QUIT
SET SRPATIN=$PIECE(SR(.2),"^",10)
SET SRPATOUT=$PIECE(SR(.2),"^",12)
SET SRNURSE=$PIECE(SR(.2),"^",7)
+3 SET DFN=$PIECE(^SRF(SRTN,0),"^")
IF $DATA(^TMP("SRPAT",$JOB,SRSDT,DFN))
DO OPCHK
IF SRCON
DO CON
QUIT
+4 IF SRPATIN=""
IF SRNURSE=""
QUIT
+5 if SRPATOUT=""
QUIT
SET TIMEOUT=SRPATOUT
if SRPATIN=""
SET SRPATIN=99999999
if SRNURSE=""
SET SRNURSE=99999999
SET TIMEIN=$SELECT(SRPATIN<SRNURSE:SRPATIN,1:SRNURSE)
DO ET
+6 SET X1=TIMEOUT
SET X=TIMEIN
DO MIN
SET SROPTIME=X
DO OT
+7 SET SRUTIL=^TMP("SR",$JOB,SRSDT,SROR)
SET SRT=$PIECE(SRUTIL,"^",5,6)
SET SRCASE=$PIECE(SRUTIL,"^")+1
+8 SET SROPDT=$PIECE(SRUTIL,"^",2)+SROPTIME
SET SRTP=$PIECE(SRUTIL,"^",3)
SET SROT=$PIECE(SRUTIL,"^",4)+SROVRT
SET ^TMP("SR",$JOB,SRSDT,SROR)=SRCASE_"^"_SROPDT_"^"_SRTP_"^"_SROT_"^"_SRT
+9 SET SRUTIL=^TMP("SR",$JOB,SRSDT)
SET SRCASE=$PIECE(SRUTIL,"^")+1
SET SROPDT=$PIECE(SRUTIL,"^",2)+SROPTIME
SET SROT=$PIECE(SRUTIL,"^",4)+SROVRT
SET ^TMP("SR",$JOB,SRSDT)=SRCASE_"^"_SROPDT_"^"_$PIECE(SRUTIL,"^",3)_"^"_SROT_"^"_$PIECE(SRUTIL,"^",5)
+10 SET SRUTIL=^TMP("SR",$JOB)
SET SRCASE=$PIECE(SRUTIL,"^")+1
SET SROPDT=$PIECE(SRUTIL,"^",2)+SROPTIME
SET SRTP=$PIECE(SRUTIL,"^",3)
SET SROT=$PIECE(SRUTIL,"^",4)+SROVRT
SET ^TMP("SR",$JOB)=SRCASE_"^"_SROPDT_"^"_SRTP_"^"_SROT
+11 SET SRUTIL=^TMP("SR",$JOB,"OR",SROR)
SET SRCASE=$PIECE(SRUTIL,"^")+1
SET SROPDT=$PIECE(SRUTIL,"^",2)+SROPTIME
SET SRTP=$PIECE(SRUTIL,"^",3)
SET SROT=$PIECE(SRUTIL,"^",4)+SROVRT
SET ^TMP("SR",$JOB,"OR",SROR)=SRCASE_"^"_SROPDT_"^"_SRTP_"^"_SROT
+12 SET ^TMP("SR",$JOB,"OR",SROR,SRTN)=""
SET ^TMP("SRPAT",$JOB,SRSDT,DFN)=SROR_"^"_SRPATIN_"^"_SRPATOUT
+13 QUIT
OT ; calculate overtime
+1 SET SROVRT=0
+2 IF 'SRTIME
SET X=TIMEIN
SET X1=TIMEOUT
DO MIN
SET SROVRT=X
+3 IF TIMEOUT<SRORST
SET X=TIMEIN
SET X1=TIMEOUT
DO MIN
SET SROVRT=X
QUIT
+4 IF TIMEIN>SROREND
SET X=TIMEIN
SET X1=TIMEOUT
DO MIN
SET SROVRT=X
QUIT
+5 IF TIMEIN<SRORST
SET X=TIMEIN
SET X1=SRORST
DO MIN
SET SROVRT=X
+6 IF TIMEOUT>SROREND
SET X=SROREND
SET X1=TIMEOUT
DO MIN
SET SROVRT=SROVRT+X
+7 QUIT
MIN ; minutes between two times
+1 SET Y=$EXTRACT(X1_"000",9,10)-$EXTRACT(X_"000",9,10)*60+$EXTRACT(X1_"00000",11,12)-$EXTRACT(X_"00000",11,12)
SET X2=X
SET X=$PIECE(X,".",1)'=$PIECE(X1,".",1)
if X
DO ^%DTC
SET X=X*1440+Y
+2 QUIT
CON SET $PIECE(^TMP("SR",$JOB,SRSDT,SROR),"^")=$PIECE(^TMP("SR",$JOB,SRSDT,SROR),"^")+1
+1 SET $PIECE(^TMP("SR",$JOB,SRSDT),"^")=$PIECE(^TMP("SR",$JOB,SRSDT),"^")+1
+2 SET $PIECE(^TMP("SR",$JOB),"^")=$PIECE(^TMP("SR",$JOB),"^")+1
+3 SET $PIECE(^TMP("SR",$JOB,"OR",SROR),"^")=$PIECE(^TMP("SR",$JOB,"OR",SROR),"^")+1
+4 SET ^TMP("SR",$JOB,"OR",SROR,SRTN)=""
+5 QUIT
ET ; add cleanup time to time out of O.R.
+1 SET CLEAN=$SELECT($DATA(^SRS(SROR,3)):+^(3),1:30)
SET SRD=$EXTRACT(TIMEOUT,1,7)
SET SRT=$PIECE(TIMEOUT,".",2)_"0000"
SET SRMIN=$EXTRACT(SRT,3,4)
SET SRHR=$EXTRACT(SRT,1,2)
+2 SET SRMIN=SRMIN+CLEAN
IF SRMIN>59
SET SRHR=SRHR+(SRMIN\60)
SET SRMIN=SRMIN#60
IF SRHR>23
SET X1=SRD
SET X2=1
DO C^%DTC
SET SRD=X
SET SRHR="00"
+3 if $LENGTH(SRHR)=1
SET SRHR="0"_SRHR
if $LENGTH(SRMIN)=1
SET SRMIN="0"_SRMIN
SET TIMEOUT=SRD_"."_SRHR_SRMIN
+4 QUIT
OPCHK ; check for concurrent case not marked conurrent
+1 SET X=^TMP("SRPAT",$JOB,SRSDT,DFN)
SET SRRM=$PIECE(X,"^")
SET SRIN=$PIECE(X,"^",2)
SET SROUT=$PIECE(X,"^",3)
if SRRM'=SROR
QUIT
+2 IF SRIN=SRPATIN
IF SROUT=SRPATOUT
SET SRCON=1
+3 QUIT
