SROUTIN.m

SROUTIN ;B'HAM ISC/MAM - INITIALIZE ^TMP FOR UTILIZATION ; [ 07/27/98   2:33 PM ]

 ;;3.0; Surgery ;**50**;24 Jun 93

ALL ; all ORs

 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

 Q

ONE ; one operating room

 D DAY F I=0:0 S SRSDATE=SRSDATE+1 Q:'SRSDATE!(SRSDATE>SRED1)  D DAY

 Q

DAY ; check for correct date

 S SRDOW=$S(SRD=0:"Sunday",SRD=1:"Monday",SRD=2:"Tuesday",SRD=3:"Wednesday",SRD=4:"Thursady",SRD=5:"Friday",SRD=6:"Saturday")

 I $E(SRSDATE,6,7)>28 S X=SRSDATE,%DT="" D ^%DT I Y<0 D DATE

 I $P($G(^SRU(SRSDATE,1,SROR,0)),"^",4)["Y" S SRTIME=0,(SRORST,SROREND)=SRSDATE D SET Q

 S TIMES=^SRU(SRSDATE,1,SROR,0),SRORST=$P(TIMES,"^",2),SROREND=$P(TIMES,"^",3)

 S X=SRORST,X1=SROREND D MIN S SRTIME=X

SET S ^TMP("SR",$J,SRSDATE,SROR)="0^0^"_SRTIME_"^0^"_SRORST_"^"_SROREND

 I '($D(^TMP("SR",$J,SRSDATE))#2) S ^TMP("SR",$J,SRSDATE)="0^0^0^0"_"^"_SRDOW

 I '($D(^TMP("SR",$J,"OR",SROR))#2) S ^TMP("SR",$J,"OR",SROR)="0^0^0^0"

 I '($D(^TMP("SR",$J))#2) S ^TMP("SR",$J)="0^0^0^0"

 S X=$P(^TMP("SR",$J,SRSDATE),"^",3),$P(^(SRSDATE),"^",3)=X+SRTIME

 S X=$P(^TMP("SR",$J,"OR",SROR),"^",3),$P(^(SROR),"^",3)=X+SRTIME

 S X=$P(^TMP("SR",$J),"^",3),$P(^($J),"^",3)=X+SRTIME

 S SRD=$S(SRD=6:0,1:SRD+1)

 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

DATE ; correct date

 I $E(SRSDATE,4,5)=12 S SRSDATE=$E(SRSDATE,1,3)_"0101"+10000 Q

 S SRNEWM=$E(SRSDATE,4,5)+1 S:$L(SRNEWM)=1 SRNEWM="0"_SRNEWM S SRNEWM=SRNEWM_"01",SRSDATE=$E(SRSDATE,1,3)_SRNEWM

 Q

SROUTIN   ;B'HAM ISC/MAM - INITIALIZE ^TMP FOR UTILIZATION ; [ 07/27/98   2:33 PM ]

 +1       ;;3.0; Surgery ;**50**;24 Jun 93

ALL       ; all ORs

 +1        SET SROR=0

           FOR 

               SET SROR=$ORDER(^SRS(SROR))

               IF 'SROR

                   QUIT 

               IF $$ORDIV^SROUTL0(SROR,SRDIV)

                   IF '$PIECE(^SRS(SROR,0),"^",6)

                       SET (SRSDATE,X)=SRSD

                       DO H^%DTC

                       SET SRD=%Y

                       DO ONE

 +2        QUIT 

ONE       ; one operating room

 +1        DO DAY

           FOR I=0:0

               SET SRSDATE=SRSDATE+1

               IF 'SRSDATE!(SRSDATE>SRED1)

                   QUIT 

               DO DAY

 +2        QUIT 

DAY       ; check for correct date

 +1        SET SRDOW=$SELECT(SRD=0:"Sunday",SRD=1:"Monday",SRD=2:"Tuesday",SRD=3:"Wednesday",SRD=4:"Thursady",SRD=5:"Friday",SRD=6:"Saturday")

 +2        IF $EXTRACT(SRSDATE,6,7)>28

               SET X=SRSDATE

               SET %DT=""

               DO ^%DT

               IF Y<0

                   DO DATE

 +3        IF $PIECE($GET(^SRU(SRSDATE,1,SROR,0)),"^",4)["Y"

               SET SRTIME=0

               SET (SRORST,SROREND)=SRSDATE

               DO SET

               QUIT 

 +4        SET TIMES=^SRU(SRSDATE,1,SROR,0)

           SET SRORST=$PIECE(TIMES,"^",2)

           SET SROREND=$PIECE(TIMES,"^",3)

 +5        SET X=SRORST

           SET X1=SROREND

           DO MIN

           SET SRTIME=X

SET        SET ^TMP("SR",$JOB,SRSDATE,SROR)="0^0^"_SRTIME_"^0^"_SRORST_"^"_SROREND

 +1        IF '($DATA(^TMP("SR",$JOB,SRSDATE))#2)

               SET ^TMP("SR",$JOB,SRSDATE)="0^0^0^0"_"^"_SRDOW

 +2        IF '($DATA(^TMP("SR",$JOB,"OR",SROR))#2)

               SET ^TMP("SR",$JOB,"OR",SROR)="0^0^0^0"

 +3        IF '($DATA(^TMP("SR",$JOB))#2)

               SET ^TMP("SR",$JOB)="0^0^0^0"

 +4        SET X=$PIECE(^TMP("SR",$JOB,SRSDATE),"^",3)

           SET $PIECE(^(SRSDATE),"^",3)=X+SRTIME

 +5        SET X=$PIECE(^TMP("SR",$JOB,"OR",SROR),"^",3)

           SET $PIECE(^(SROR),"^",3)=X+SRTIME

 +6        SET X=$PIECE(^TMP("SR",$JOB),"^",3)

           SET $PIECE(^($JOB),"^",3)=X+SRTIME

 +7        SET SRD=$SELECT(SRD=6:0,1:SRD+1)

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

DATE      ; correct date

 +1        IF $EXTRACT(SRSDATE,4,5)=12

               SET SRSDATE=$EXTRACT(SRSDATE,1,3)_"0101"+10000

               QUIT 

 +2        SET SRNEWM=$EXTRACT(SRSDATE,4,5)+1

           IF $LENGTH(SRNEWM)=1

               SET SRNEWM="0"_SRNEWM

           SET SRNEWM=SRNEWM_"01"

           SET SRSDATE=$EXTRACT(SRSDATE,1,3)_SRNEWM

 +3        QUIT