source: WorldVistAEHR/trunk/r/SURGERY-SR/SROUTIN.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.6 KB
RevLine 
[613]1SROUTIN ;B'HAM ISC/MAM - INITIALIZE ^TMP FOR UTILIZATION ; [ 07/27/98 2:33 PM ]
2 ;;3.0; Surgery ;**50**;24 Jun 93
3ALL ; all ORs
4 S SROR=0 F S SROR=$O(^SRS(SROR)) Q:'SROR I $$ORDIV^SROUTL0(SROR,SRDIV),'$P(^SRS(SROR,0),"^",6) S (SRSDATE,X)=SRSD D H^%DTC S SRD=%Y D ONE
5 Q
6ONE ; one operating room
7 D DAY F I=0:0 S SRSDATE=SRSDATE+1 Q:'SRSDATE!(SRSDATE>SRED1) D DAY
8 Q
9DAY ; check for correct date
10 S SRDOW=$S(SRD=0:"Sunday",SRD=1:"Monday",SRD=2:"Tuesday",SRD=3:"Wednesday",SRD=4:"Thursady",SRD=5:"Friday",SRD=6:"Saturday")
11 I $E(SRSDATE,6,7)>28 S X=SRSDATE,%DT="" D ^%DT I Y<0 D DATE
12 I $P($G(^SRU(SRSDATE,1,SROR,0)),"^",4)["Y" S SRTIME=0,(SRORST,SROREND)=SRSDATE D SET Q
13 S TIMES=^SRU(SRSDATE,1,SROR,0),SRORST=$P(TIMES,"^",2),SROREND=$P(TIMES,"^",3)
14 S X=SRORST,X1=SROREND D MIN S SRTIME=X
15SET S ^TMP("SR",$J,SRSDATE,SROR)="0^0^"_SRTIME_"^0^"_SRORST_"^"_SROREND
16 I '($D(^TMP("SR",$J,SRSDATE))#2) S ^TMP("SR",$J,SRSDATE)="0^0^0^0"_"^"_SRDOW
17 I '($D(^TMP("SR",$J,"OR",SROR))#2) S ^TMP("SR",$J,"OR",SROR)="0^0^0^0"
18 I '($D(^TMP("SR",$J))#2) S ^TMP("SR",$J)="0^0^0^0"
19 S X=$P(^TMP("SR",$J,SRSDATE),"^",3),$P(^(SRSDATE),"^",3)=X+SRTIME
20 S X=$P(^TMP("SR",$J,"OR",SROR),"^",3),$P(^(SROR),"^",3)=X+SRTIME
21 S X=$P(^TMP("SR",$J),"^",3),$P(^($J),"^",3)=X+SRTIME
22 S SRD=$S(SRD=6:0,1:SRD+1)
23 Q
24MIN ; minutes between two times
25 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
26 Q
27DATE ; correct date
28 I $E(SRSDATE,4,5)=12 S SRSDATE=$E(SRSDATE,1,3)_"0101"+10000 Q
29 S SRNEWM=$E(SRSDATE,4,5)+1 S:$L(SRNEWM)=1 SRNEWM="0"_SRNEWM S SRNEWM=SRNEWM_"01",SRSDATE=$E(SRSDATE,1,3)_SRNEWM
30 Q
Note: See TracBrowser for help on using the repository browser.