SRSAVG ;BIR/MAM - CALCULATE AVG OPERATION TIME ;18 JAN 1990 8:00 AM
;;3.0; Surgery ;**12,13,142**;24 Jun 93
I 'SRSPEC S SRAVG="" Q
I 'SRSCPT S SRAVG="" Q
I '$D(^SRO(131.25,SRSPEC,1,SRSCPT,0)) S SRAVG="" Q
S SRAV=^SRO(131.25,SRSPEC,1,SRSCPT,0),SRMIN=$P(SRAV,"^",2),SRNUM=$P(SRAV,"^",3),SRAV=SRMIN/SRNUM,SRAV=SRAV\1
S SRAV1=SRAV#60,SRAV=SRAV\60 S:SRAV1?1N SRAV1=0_SRAV1 S SRAVG=SRAV_":"_SRAV1
Q
TASK ; nightly task to update average times
S X1=DT,X2=-14 D C^%DTC S DATE=X,SRSDATE=DATE-.0001,END=DATE+.9999
F S SRSDATE=$O(^SRF("AC",SRSDATE)) Q:'SRSDATE!(SRSDATE>END) S SRTN=0 F S SRTN=$O(^SRF("AC",SRSDATE,SRTN)) Q:'SRTN D UPDATE
K SRTN D ^SRSKILL
Q
UPDATE ; update operation times
S SRSPEC=$P(^SRF(SRTN,0),"^",4),SRSCPT=$P($G(^SRO(136,SRTN,0)),"^",2)
S SR(.2)=$S($D(^SRF(SRTN,.2)):^(.2),1:""),SRIN=$P(SR(.2),"^",2),SROUT=$P(SR(.2),"^",3)
I SRSPEC=""!(SRSCPT="")!(SRIN="")!(SROUT="") Q
S X=SRIN,X1=SROUT,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 SRTIME=X*1440+Y
I '$D(^SRO(131.25,SRSPEC,0)) K DD,DO S DIC="^SRO(131.25,",DIC(0)="L",DLAYGO=131.25,(X,DINUM)=SRSPEC D FILE^DICN K DIC,DLAYGO
I '$D(^SRO(131.25,SRSPEC,1)) S ^SRO(131.25,SRSPEC,1,0)="^131.251PA^0^0"
S $P(^SRO(131.25,SRSPEC,1,0),"^",4)=$P(^SRO(131.25,SRSPEC,1,0),"^",4)+1 I SRSCPT>$P(^SRO(131.25,SRSPEC,1,0),"^",3) S $P(^(0),"^",3)=SRSCPT
I '$D(^SRO(131.25,SRSPEC,1,SRSCPT,0)) S ^SRO(131.25,SRSPEC,1,SRSCPT,0)=SRSCPT_"^"_SRTIME_"^"_1 Q
S $P(^SRO(131.25,SRSPEC,1,SRSCPT,0),"^",2)=$P(^SRO(131.25,SRSPEC,1,SRSCPT,0),"^",2)+SRTIME,$P(^(0),"^",3)=$P(^(0),"^",3)+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRSAVG 1651 printed Oct 16, 2024@18:47:29 Page 2
SRSAVG ;BIR/MAM - CALCULATE AVG OPERATION TIME ;18 JAN 1990 8:00 AM
+1 ;;3.0; Surgery ;**12,13,142**;24 Jun 93
+2 IF 'SRSPEC
SET SRAVG=""
QUIT
+3 IF 'SRSCPT
SET SRAVG=""
QUIT
+4 IF '$DATA(^SRO(131.25,SRSPEC,1,SRSCPT,0))
SET SRAVG=""
QUIT
+5 SET SRAV=^SRO(131.25,SRSPEC,1,SRSCPT,0)
SET SRMIN=$PIECE(SRAV,"^",2)
SET SRNUM=$PIECE(SRAV,"^",3)
SET SRAV=SRMIN/SRNUM
SET SRAV=SRAV\1
+6 SET SRAV1=SRAV#60
SET SRAV=SRAV\60
if SRAV1?1N
SET SRAV1=0_SRAV1
SET SRAVG=SRAV_":"_SRAV1
+7 QUIT
TASK ; nightly task to update average times
+1 SET X1=DT
SET X2=-14
DO C^%DTC
SET DATE=X
SET SRSDATE=DATE-.0001
SET END=DATE+.9999
+2 FOR
SET SRSDATE=$ORDER(^SRF("AC",SRSDATE))
if 'SRSDATE!(SRSDATE>END)
QUIT
SET SRTN=0
FOR
SET SRTN=$ORDER(^SRF("AC",SRSDATE,SRTN))
if 'SRTN
QUIT
DO UPDATE
+3 KILL SRTN
DO ^SRSKILL
+4 QUIT
UPDATE ; update operation times
+1 SET SRSPEC=$PIECE(^SRF(SRTN,0),"^",4)
SET SRSCPT=$PIECE($GET(^SRO(136,SRTN,0)),"^",2)
+2 SET SR(.2)=$SELECT($DATA(^SRF(SRTN,.2)):^(.2),1:"")
SET SRIN=$PIECE(SR(.2),"^",2)
SET SROUT=$PIECE(SR(.2),"^",3)
+3 IF SRSPEC=""!(SRSCPT="")!(SRIN="")!(SROUT="")
QUIT
+4 SET X=SRIN
SET X1=SROUT
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 SRTIME=X*1440+Y
+5 IF '$DATA(^SRO(131.25,SRSPEC,0))
KILL DD,DO
SET DIC="^SRO(131.25,"
SET DIC(0)="L"
SET DLAYGO=131.25
SET (X,DINUM)=SRSPEC
DO FILE^DICN
KILL DIC,DLAYGO
+6 IF '$DATA(^SRO(131.25,SRSPEC,1))
SET ^SRO(131.25,SRSPEC,1,0)="^131.251PA^0^0"
+7 SET $PIECE(^SRO(131.25,SRSPEC,1,0),"^",4)=$PIECE(^SRO(131.25,SRSPEC,1,0),"^",4)+1
IF SRSCPT>$PIECE(^SRO(131.25,SRSPEC,1,0),"^",3)
SET $PIECE(^(0),"^",3)=SRSCPT
+8 IF '$DATA(^SRO(131.25,SRSPEC,1,SRSCPT,0))
SET ^SRO(131.25,SRSPEC,1,SRSCPT,0)=SRSCPT_"^"_SRTIME_"^"_1
QUIT
+9 SET $PIECE(^SRO(131.25,SRSPEC,1,SRSCPT,0),"^",2)=$PIECE(^SRO(131.25,SRSPEC,1,SRSCPT,0),"^",2)+SRTIME
SET $PIECE(^(0),"^",3)=$PIECE(^(0),"^",3)+1
+10 QUIT
