Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SRSPUT0

SRSPUT0.m

Go to the documentation of this file.
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