- 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 Feb 19, 2025@00:13:19 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
