- 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
- 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
