SRSUTIN ;B'HAM ISC/MAM - INITIALIZE ^TMP FOR UTILIZATION ; 16 MAY 1990 10:55 AM
;;3.0; Surgery ;;24 Jun 93
ALL ; all Surgical Specialties
S SRSS=0 F I=0:0 S SRSS=$O(^SRO(137.45,SRSS)) Q:'SRSS S SRSP=$P(^SRO(137.45,SRSS,0),"^"),(SRSDATE,X)=SRSD D H^%DTC S SRD=%Y D ONE
Q
ONE ; one surgical specialty
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:"Thursday",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,2,SRSS,0)),"^",4)["Y" S SRTIME=0,(SRSPST,SRSPEND)=SRSDATE D SET Q
S TIMES=^SRU(SRSDATE,2,SRSS,0),SRSPST=$P(TIMES,"^",2),SRSPEND=$P(TIMES,"^",3)
S X=SRSPST,X1=SRSPEND D MIN S SRTIME=X
SET S ^TMP("SR",$J,SRSDATE,SRSP)="0^0^"_SRTIME_"^0^"_SRSPST_"^"_SRSPEND
I '($D(^TMP("SR",$J,"SP",SRSP))#2) S ^TMP("SR",$J,"SP",SRSP)="0^0^0^0"
I '($D(^TMP("SR",$J))#2) S ^TMP("SR",$J)="0^0^0^0"
S X=$P(^TMP("SR",$J,"SP",SRSP),"^",3),$P(^(SRSP),"^",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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRSUTIN 1547 printed Dec 13, 2024@02:47:51 Page 2
SRSUTIN ;B'HAM ISC/MAM - INITIALIZE ^TMP FOR UTILIZATION ; 16 MAY 1990 10:55 AM
+1 ;;3.0; Surgery ;;24 Jun 93
ALL ; all Surgical Specialties
+1 SET SRSS=0
FOR I=0:0
SET SRSS=$ORDER(^SRO(137.45,SRSS))
if 'SRSS
QUIT
SET SRSP=$PIECE(^SRO(137.45,SRSS,0),"^")
SET (SRSDATE,X)=SRSD
DO H^%DTC
SET SRD=%Y
DO ONE
+2 QUIT
ONE ; one surgical specialty
+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:"Thursday",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,2,SRSS,0)),"^",4)["Y"
SET SRTIME=0
SET (SRSPST,SRSPEND)=SRSDATE
DO SET
QUIT
+4 SET TIMES=^SRU(SRSDATE,2,SRSS,0)
SET SRSPST=$PIECE(TIMES,"^",2)
SET SRSPEND=$PIECE(TIMES,"^",3)
+5 SET X=SRSPST
SET X1=SRSPEND
DO MIN
SET SRTIME=X
SET SET ^TMP("SR",$JOB,SRSDATE,SRSP)="0^0^"_SRTIME_"^0^"_SRSPST_"^"_SRSPEND
+1 IF '($DATA(^TMP("SR",$JOB,"SP",SRSP))#2)
SET ^TMP("SR",$JOB,"SP",SRSP)="0^0^0^0"
+2 IF '($DATA(^TMP("SR",$JOB))#2)
SET ^TMP("SR",$JOB)="0^0^0^0"
+3 SET X=$PIECE(^TMP("SR",$JOB,"SP",SRSP),"^",3)
SET $PIECE(^(SRSP),"^",3)=X+SRTIME
+4 SET X=$PIECE(^TMP("SR",$JOB),"^",3)
SET $PIECE(^($JOB),"^",3)=X+SRTIME
+5 SET SRD=$SELECT(SRD=6:0,1:SRD+1)
+6 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
