SRSPUT0 ;B'HAM ISC/MAM - SPECIALTY UTILIZATION ; 15 MAY 1990 1:30 PM
;;3.0; Surgery ;;24 Jun 93
EN ; entry when queued
K ^TMP("SR",$J) S SRSOUT=0,SRFLG=1,SRINST="VAMC - "_$P($$SITE^SROVAR,"^",2)
I SRSS="ALL" S SRFLG=0 D ALL^SRSUTIN S SRSS=0 D AC
I SRFLG S SRSP=$P(^SRO(137.45,SRSS,0),"^"),(X,SRSDATE)=SRSD D H^%DTC S SRD=%Y D ONE^SRSUTIN S (SRSDATE,SRSD2)=SRSD1 D AC
U IO S SRSSDT=$E(SRSD,4,5)_"/"_$E(SRSD,6,7)_"/"_$E(SRSD,2,3),SRSEDT=$E(SRED,4,5)_"/"_$E(SRED,6,7)_"/"_$E(SRED,2,3)
S SRHDR="FROM "_SRSSDT_" TO "_SRSEDT,PAGE=0
D ^SRSPUT1
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
Q
DAY ; get start times
S SRSD2=$E(SRSDATE,1,7)
S TIMES=$P(^TMP("SR",$J,SRSD2,SRSP),"^",5,6),SRSPST=$P(TIMES,"^"),SRSPEND=$P(TIMES,"^",2),SRTIME=1
S X=$P(SRSPST,".",2) S:'X SRTIME="" S X=$P(SRSPEND,".",2) S:'X SRTIME=""
Q
UTIL ; set ^TMP("SR"
S SRSPEC=$P(^SRF(SRTN,0),"^",4) I SRFLG,SRSPEC'=SRSS Q
I SRFLG,$E(SRSDATE,1,7)'=SRSD2 D DAY
I 'SRFLG S SRSP=$P(^SRO(137.45,SRSPEC,0),"^") D DAY
S SR(.2)=$S($D(^SRF(SRTN,.2)):^(.2),1:"") S SRPATIN=$P(SR(.2),"^",10),SRPATOUT=$P(SR(.2),"^",12),SRNURSE=$P(SR(.2),"^",7)
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)
S SRCON=$P($G(^SRF(SRTN,"CON")),"^") I SRCON,$P($G(^SRF(SRCON,.2)),"^",12) D CON Q
S X1=TIMEOUT,X=TIMEIN D MIN S SROPTIME=X D OT
SET 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,"SP",SRSP),SRCASE=$P(SRUTIL,"^")+1,SROPDT=$P(SRUTIL,"^",2)+SROPTIME,SRTP=$P(SRUTIL,"^",3),SROT=$P(SRUTIL,"^",4)+SROVRT,^TMP("SR",$J,"SP",SRSP)=SRCASE_"^"_SROPDT_"^"_SRTP_"^"_SROT
S SRUTIL=^TMP("SR",$J,SRSD2,SRSP),SRT=$P(SRUTIL,"^",5,6),SRCASE=$P(SRUTIL,"^")+1,SROPDT=$P(SRUTIL,"^",2)+SROPTIME
S SRTP=$P(SRUTIL,"^",3),SROT=$P(SRUTIL,"^",4)+SROVRT,^TMP("SR",$J,SRSD2,SRSP)=SRCASE_"^"_SROPDT_"^"_SRTP_"^"_SROT_"^"_SRT
Q
OT ; calculate overtime
S SROVRT=0
I 'SRTIME S X=TIMEIN,X1=TIMEOUT D MIN S SROVRT=X
I TIMEOUT<SRSPST S X=TIMEIN,X1=TIMEOUT D MIN S SROVRT=X Q
I TIMEIN>SRSPEND S X=TIMEIN,X1=TIMEOUT D MIN S SROVRT=X Q
I TIMEIN<SRSPST S X=TIMEIN,X1=SRSPST D MIN S SROVRT=X
I TIMEOUT>SRSPEND S X=SRSPEND,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
AC S SRSDATE=SRSD1
F S SRSDATE=$O(^SRF("AC",SRSDATE)) Q:'SRSDATE!(SRSDATE>SRED1) S SRTN=0 F S SRTN=$O(^SRF("AC",SRSDATE,SRTN)) Q:'SRTN D UTIL
Q
CON S SR1=$P($G(^SRF(SRTN,.2)),"^",2),SR2=$P($G(^SRF(SRCON,.2)),"^",2)
I 'SR1,'SR2 S X1=TIMEOUT,X=TIMEIN D MIN S SROPTIME=(X*.5)+.5\1*1 D OT S SROVRT=(SROVRT*.5)+.5\1*1 D SET Q
Q:'SR1 I 'SR2 S X1=TIMEOUT,X=TIMEIN D MIN S SROPTIME=X D OT,SET Q
I SR1'>SR2 S SR1=$P($G(^SRF(SRTN,.2)),"^",3) S:'SR1 SR1=SR2 S X=SR1,X1=SR2 D MIN S SRH=$S(X<0:(X*(-.5)),1:(X*.5)),SRH=SRH+.5\1*1,(X1,TIMEOUT)=SR1,X=TIMEIN D MIN S SROPTIME=X+SRH D OT,SET Q
S SR2=$P($G(^SRF(SRCON,.2)),"^",3) S:'SR2 SR2=SR1 S X=SR2,X1=SR1 D MIN S SRH=$S(X<0:(X*(-.5)),1:(X*.5)),SRH=SRH+.5\1*1,X1=TIMEOUT,(TIMEIN,X)=SR1 D MIN S SROPTIME=X+SRH D OT,SET
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRSPUT0 3423 printed Apr 09, 2024@21:44:30 Page 2
SRSPUT0 ;B'HAM ISC/MAM - SPECIALTY UTILIZATION ; 15 MAY 1990 1:30 PM
+1 ;;3.0; Surgery ;;24 Jun 93
EN ; entry when queued
+1 KILL ^TMP("SR",$JOB)
SET SRSOUT=0
SET SRFLG=1
SET SRINST="VAMC - "_$PIECE($$SITE^SROVAR,"^",2)
+2 IF SRSS="ALL"
SET SRFLG=0
DO ALL^SRSUTIN
SET SRSS=0
DO AC
+3 IF SRFLG
SET SRSP=$PIECE(^SRO(137.45,SRSS,0),"^")
SET (X,SRSDATE)=SRSD
DO H^%DTC
SET SRD=%Y
DO ONE^SRSUTIN
SET (SRSDATE,SRSD2)=SRSD1
DO AC
+4 USE IO
SET SRSSDT=$EXTRACT(SRSD,4,5)_"/"_$EXTRACT(SRSD,6,7)_"/"_$EXTRACT(SRSD,2,3)
SET SRSEDT=$EXTRACT(SRED,4,5)_"/"_$EXTRACT(SRED,6,7)_"/"_$EXTRACT(SRED,2,3)
+5 SET SRHDR="FROM "_SRSSDT_" TO "_SRSEDT
SET PAGE=0
+6 DO ^SRSPUT1
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
+2 QUIT
DAY ; get start times
+1 SET SRSD2=$EXTRACT(SRSDATE,1,7)
+2 SET TIMES=$PIECE(^TMP("SR",$JOB,SRSD2,SRSP),"^",5,6)
SET SRSPST=$PIECE(TIMES,"^")
SET SRSPEND=$PIECE(TIMES,"^",2)
SET SRTIME=1
+3 SET X=$PIECE(SRSPST,".",2)
if 'X
SET SRTIME=""
SET X=$PIECE(SRSPEND,".",2)
if 'X
SET SRTIME=""
+4 QUIT
UTIL ; set ^TMP("SR"
+1 SET SRSPEC=$PIECE(^SRF(SRTN,0),"^",4)
IF SRFLG
IF SRSPEC'=SRSS
QUIT
+2 IF SRFLG
IF $EXTRACT(SRSDATE,1,7)'=SRSD2
DO DAY
+3 IF 'SRFLG
SET SRSP=$PIECE(^SRO(137.45,SRSPEC,0),"^")
DO DAY
+4 SET SR(.2)=$SELECT($DATA(^SRF(SRTN,.2)):^(.2),1:"")
SET SRPATIN=$PIECE(SR(.2),"^",10)
SET SRPATOUT=$PIECE(SR(.2),"^",12)
SET SRNURSE=$PIECE(SR(.2),"^",7)
+5 IF SRPATIN=""
IF SRNURSE=""
QUIT
+6 if SRPATOUT=""
QUIT
SET TIMEOUT=SRPATOUT
if SRPATIN=""
SET SRPATIN=99999999
if SRNURSE=""
SET SRNURSE=99999999
SET TIMEIN=$SELECT(SRPATIN<SRNURSE:SRPATIN,1:SRNURSE)
+7 SET SRCON=$PIECE($GET(^SRF(SRTN,"CON")),"^")
IF SRCON
IF $PIECE($GET(^SRF(SRCON,.2)),"^",12)
DO CON
QUIT
+8 SET X1=TIMEOUT
SET X=TIMEIN
DO MIN
SET SROPTIME=X
DO OT
SET 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
+1 SET SRUTIL=^TMP("SR",$JOB,"SP",SRSP)
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,"SP",SRSP)=SRCASE_"^"_SROPDT_"^"_SRTP_"^"_SROT
+2 SET SRUTIL=^TMP("SR",$JOB,SRSD2,SRSP)
SET SRT=$PIECE(SRUTIL,"^",5,6)
SET SRCASE=$PIECE(SRUTIL,"^")+1
SET SROPDT=$PIECE(SRUTIL,"^",2)+SROPTIME
+3 SET SRTP=$PIECE(SRUTIL,"^",3)
SET SROT=$PIECE(SRUTIL,"^",4)+SROVRT
SET ^TMP("SR",$JOB,SRSD2,SRSP)=SRCASE_"^"_SROPDT_"^"_SRTP_"^"_SROT_"^"_SRT
+4 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<SRSPST
SET X=TIMEIN
SET X1=TIMEOUT
DO MIN
SET SROVRT=X
QUIT
+4 IF TIMEIN>SRSPEND
SET X=TIMEIN
SET X1=TIMEOUT
DO MIN
SET SROVRT=X
QUIT
+5 IF TIMEIN<SRSPST
SET X=TIMEIN
SET X1=SRSPST
DO MIN
SET SROVRT=X
+6 IF TIMEOUT>SRSPEND
SET X=SRSPEND
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
AC SET SRSDATE=SRSD1
+1 FOR
SET SRSDATE=$ORDER(^SRF("AC",SRSDATE))
if 'SRSDATE!(SRSDATE>SRED1)
QUIT
SET SRTN=0
FOR
SET SRTN=$ORDER(^SRF("AC",SRSDATE,SRTN))
if 'SRTN
QUIT
DO UTIL
+2 QUIT
CON SET SR1=$PIECE($GET(^SRF(SRTN,.2)),"^",2)
SET SR2=$PIECE($GET(^SRF(SRCON,.2)),"^",2)
+1 IF 'SR1
IF 'SR2
SET X1=TIMEOUT
SET X=TIMEIN
DO MIN
SET SROPTIME=(X*.5)+.5\1*1
DO OT
SET SROVRT=(SROVRT*.5)+.5\1*1
DO SET
QUIT
+2 if 'SR1
QUIT
IF 'SR2
SET X1=TIMEOUT
SET X=TIMEIN
DO MIN
SET SROPTIME=X
DO OT
DO SET
QUIT
+3 IF SR1'>SR2
SET SR1=$PIECE($GET(^SRF(SRTN,.2)),"^",3)
if 'SR1
SET SR1=SR2
SET X=SR1
SET X1=SR2
DO MIN
SET SRH=$SELECT(X<0:(X*(-.5)),1:(X*.5))
SET SRH=SRH+.5\1*1
SET (X1,TIMEOUT)=SR1
SET X=TIMEIN
DO MIN
SET SROPTIME=X+SRH
DO OT
DO SET
QUIT
+4 SET SR2=$PIECE($GET(^SRF(SRCON,.2)),"^",3)
if 'SR2
SET SR2=SR1
SET X=SR2
SET X1=SR1
DO MIN
SET SRH=$SELECT(X<0:(X*(-.5)),1:(X*.5))
SET SRH=SRH+.5\1*1
SET X1=TIMEOUT
SET (TIMEIN,X)=SR1
DO MIN
SET SROPTIME=X+SRH
DO OT
DO SET
+5 QUIT
