- 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 Feb 19, 2025@00:12:26 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