SRORAT1 ;B'HAM ISC/MAM - CANCELLATION RATES, 1 SPECIALTY ;[ 04/06/00 10:19 AM ]
;;3.0;Surgery;**14,63,94,182**;24 Jun 93;Build 49
S (PAGE,SRSOUT,SRCT)=0 F S SRCT=$O(SRSS(SRCT)) Q:'SRCT!SRSOUT S SRSS=SRSS(SRCT) D SPEC I $E(IOST)'="P" D PAGE Q:SRSOUT
S SRSOUT=1 Q
SPEC K ^TMP("SR",$J),^TMP("SRT",$J) S SRHDR=0,^TMP("SR",$J)="0^0^0"
S SRSDATE=SRSD-.0001,SREDT=SRED+.9999,SRSSNM="** "_$P(^SRO(137.45,SRSS,0),"^")_" **"
F S SRSDATE=$O(^SRF("AC",SRSDATE)) Q:'SRSDATE!(SRSDATE>SREDT) S SRTN=0 F S SRTN=$O(^SRF("AC",SRSDATE,SRTN)) Q:'SRTN I $D(^SRF(SRTN,0)),$$MANDIV^SROUTL0(SRINSTP,SRTN) D UTIL
D HDR Q:SRSOUT
S X=^TMP("SR",$J),Y=$P(X,"^"),TOTAL=Y+$P(X,"^",3),X=$P(X,"^",2),CANRATE=$S(Y>0:X/Y*100,1:0),CANRATE=CANRATE+.5\1*1,TOTRATE=$S(TOTAL>0:X/TOTAL*100,1:0),TOTRATE=TOTRATE+.5\1*1
S TCAN=$S(TOTAL>0:Y/TOTAL*100,1:0),TCAN=TCAN+.5\1*1,TPRCNT="CANCELLATION RATE FOR SCHEDULED CASES: "_TCAN_" %"
S SPRCNT="AVOIDABLE CANCELLATION RATE FOR SCHEDULED CASES: "_TOTRATE_" %"
S CPRCNT="AVOIDABLE CANCELLATION RATE FOR CANCELLED CASES: "_CANRATE_" %"
S TOTAL="TOTAL SCHEDULED SURGICAL CASES: "_TOTAL
S SRCOL=80-$L(SRSSNM)\2 W !!,?SRCOL,SRSSNM
W !!,TOTAL,!,TPRCNT,!,SPRCNT,!,CPRCNT D SUB
S REASON=0 F S REASON=$O(^TMP("SR",$J,REASON)) Q:REASON=""!(SRSOUT) D REASON
S X=$P(^TMP("SR",$J),"^"),Y=$P(^($J),"^",2)
W !,?47,"-----",?64,"-----",!,"TOTAL CANCELLATIONS",?47,$J(X,4),?64,$J(Y,4)
Q
REASON I $Y+5>IOSL D PAGE Q:SRSOUT D SUB
S X=$P(^TMP("SR",$J,REASON),"^"),Y=$P(^(REASON),"^",2)
W !,$S($E(REASON,1,2)="ZZ":$E(REASON,3,45),1:REASON),?47,$J(X,4),?64,$J(Y,4)
Q
UTIL ; set ^TMP
Q:$P($G(^SRF(SRTN,"NON")),"^")="Y" S STORE=0,TYPE=$P(^SRF(SRTN,0),"^",10) Q:TYPE="EM" I $P($G(^SRF(SRTN,30)),"^")=""&($P($G(^(31)),"^",4)="")&($P($G(^(31)),"^",5)="") Q
S X=$P(^SRF(SRTN,0),"^",4) I X'=SRSS Q
I $P($G(^SRF(SRTN,30)),"^") S STORE=2
I $P($G(^SRF(SRTN,31)),"^",8) S STORE=2
I $P($G(^SRF(SRTN,.2)),"^",12) S STORE=1,AVOID=""
I 'STORE Q
I STORE=2 S AVOID=0,X=$S($D(^SRF(SRTN,31)):$P(^(31),"^",8),1:""),REASON=$S(X:$P(^SRO(135,X,0),"^")_"^"_$P($G(^SRF(SRTN,30)),"^",2),1:"ZZNO REASON ENTERED"_"^"_"A") S AVOID=$S($P(REASON,"^",2)="N":0,1:1),REASON=$P(REASON,"^")
I STORE=2,'$D(^TMP("SR",$J,REASON)) S ^TMP("SR",$J,REASON)="0^0"
I STORE=1 S $P(^TMP("SR",$J),"^",3)=$P(^TMP("SR",$J),"^",3)+1 Q
S $P(^TMP("SR",$J),"^")=$P(^TMP("SR",$J),"^")+1 I STORE=2 S $P(^TMP("SR",$J,REASON),"^")=$P(^TMP("SR",$J,REASON),"^")+1
I 'AVOID Q
S $P(^TMP("SR",$J),"^",2)=$P(^TMP("SR",$J),"^",2)+1,$P(^TMP("SR",$J,REASON),"^",2)=$P(^TMP("SR",$J,REASON),"^",2)+1
Q
PAGE S X="" I $E(IOST)'="P" W !!!,"Press RETURN to continue, or '^' to quit: " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q
I X["?" W !!,"Enter RETURN to continue printing this report, or '^' to exit from this option." G PAGE
HDR ; print heading
I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q
S X=$E(SRSD,4,5)_"/"_$E(SRSD,6,7)_"/"_$E(SRSD,2,3),Y=$E(SRED,4,5)_"/"_$E(SRED,6,7)_"/"_$E(SRED,2,3),PAGE=PAGE+1 I $Y W @IOF
I $E(IOST)'="P" Q
W !,?(80-$L(SRINST)\2),SRINST,?70,"PAGE: "_PAGE,!,?32,"SURGICAL SERVICE",!,?28,"CANCELLATION RATE REPORT",!,?27,"FROM "_X_" TO "_Y
S X=$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3) W !,?29,"DATE PRINTED: "_X
W !,?21,"REVIEWED BY:",?45,"DATE REVIEWED:",!
W ! F LINE=1:1:80 W "="
Q
SUB ; print column headings
W !!,"PRIMARY CANCELLATION REASON",?45,"TOTAL CANCELS",?62,"TOTAL AVOIDABLE",! F LINE=1:1:80 W "-"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRORAT1 3453 printed Apr 09, 2024@21:42:16 Page 2
SRORAT1 ;B'HAM ISC/MAM - CANCELLATION RATES, 1 SPECIALTY ;[ 04/06/00 10:19 AM ]
+1 ;;3.0;Surgery;**14,63,94,182**;24 Jun 93;Build 49
+2 SET (PAGE,SRSOUT,SRCT)=0
FOR
SET SRCT=$ORDER(SRSS(SRCT))
if 'SRCT!SRSOUT
QUIT
SET SRSS=SRSS(SRCT)
DO SPEC
IF $EXTRACT(IOST)'="P"
DO PAGE
if SRSOUT
QUIT
+3 SET SRSOUT=1
QUIT
SPEC KILL ^TMP("SR",$JOB),^TMP("SRT",$JOB)
SET SRHDR=0
SET ^TMP("SR",$JOB)="0^0^0"
+1 SET SRSDATE=SRSD-.0001
SET SREDT=SRED+.9999
SET SRSSNM="** "_$PIECE(^SRO(137.45,SRSS,0),"^")_" **"
+2 FOR
SET SRSDATE=$ORDER(^SRF("AC",SRSDATE))
if 'SRSDATE!(SRSDATE>SREDT)
QUIT
SET SRTN=0
FOR
SET SRTN=$ORDER(^SRF("AC",SRSDATE,SRTN))
if 'SRTN
QUIT
IF $DATA(^SRF(SRTN,0))
IF $$MANDIV^SROUTL0(SRINSTP,SRTN)
DO UTIL
+3 DO HDR
if SRSOUT
QUIT
+4 SET X=^TMP("SR",$JOB)
SET Y=$PIECE(X,"^")
SET TOTAL=Y+$PIECE(X,"^",3)
SET X=$PIECE(X,"^",2)
SET CANRATE=$SELECT(Y>0:X/Y*100,1:0)
SET CANRATE=CANRATE+.5\1*1
SET TOTRATE=$SELECT(TOTAL>0:X/TOTAL*100,1:0)
SET TOTRATE=TOTRATE+.5\1*1
+5 SET TCAN=$SELECT(TOTAL>0:Y/TOTAL*100,1:0)
SET TCAN=TCAN+.5\1*1
SET TPRCNT="CANCELLATION RATE FOR SCHEDULED CASES: "_TCAN_" %"
+6 SET SPRCNT="AVOIDABLE CANCELLATION RATE FOR SCHEDULED CASES: "_TOTRATE_" %"
+7 SET CPRCNT="AVOIDABLE CANCELLATION RATE FOR CANCELLED CASES: "_CANRATE_" %"
+8 SET TOTAL="TOTAL SCHEDULED SURGICAL CASES: "_TOTAL
+9 SET SRCOL=80-$LENGTH(SRSSNM)\2
WRITE !!,?SRCOL,SRSSNM
+10 WRITE !!,TOTAL,!,TPRCNT,!,SPRCNT,!,CPRCNT
DO SUB
+11 SET REASON=0
FOR
SET REASON=$ORDER(^TMP("SR",$JOB,REASON))
if REASON=""!(SRSOUT)
QUIT
DO REASON
+12 SET X=$PIECE(^TMP("SR",$JOB),"^")
SET Y=$PIECE(^($JOB),"^",2)
+13 WRITE !,?47,"-----",?64,"-----",!,"TOTAL CANCELLATIONS",?47,$JUSTIFY(X,4),?64,$JUSTIFY(Y,4)
+14 QUIT
REASON IF $Y+5>IOSL
DO PAGE
if SRSOUT
QUIT
DO SUB
+1 SET X=$PIECE(^TMP("SR",$JOB,REASON),"^")
SET Y=$PIECE(^(REASON),"^",2)
+2 WRITE !,$SELECT($EXTRACT(REASON,1,2)="ZZ":$EXTRACT(REASON,3,45),1:REASON),?47,$JUSTIFY(X,4),?64,$JUSTIFY(Y,4)
+3 QUIT
UTIL ; set ^TMP
+1 if $PIECE($GET(^SRF(SRTN,"NON")),"^")="Y"
QUIT
SET STORE=0
SET TYPE=$PIECE(^SRF(SRTN,0),"^",10)
if TYPE="EM"
QUIT
IF $PIECE($GET(^SRF(SRTN,30)),"^")=""&($PIECE($GET(^(31)),"^",4)="")&($PIECE($GET(^(31)),"^",5)="")
QUIT
+2 SET X=$PIECE(^SRF(SRTN,0),"^",4)
IF X'=SRSS
QUIT
+3 IF $PIECE($GET(^SRF(SRTN,30)),"^")
SET STORE=2
+4 IF $PIECE($GET(^SRF(SRTN,31)),"^",8)
SET STORE=2
+5 IF $PIECE($GET(^SRF(SRTN,.2)),"^",12)
SET STORE=1
SET AVOID=""
+6 IF 'STORE
QUIT
+7 IF STORE=2
SET AVOID=0
SET X=$SELECT($DATA(^SRF(SRTN,31)):$PIECE(^(31),"^",8),1:"")
SET REASON=$SELECT(X:$PIECE(^SRO(135,X,0),"^")_"^"_$PIECE($GET(^SRF(SRTN,30)),"^",2),1:"ZZNO REASON ENTERED"_"^"_"A")
SET AVOID=$SELECT($PIECE(REASON,"^",2)="N":0,1:1)
SET REASON=$PIECE(REASON,"^")
+8 IF STORE=2
IF '$DATA(^TMP("SR",$JOB,REASON))
SET ^TMP("SR",$JOB,REASON)="0^0"
+9 IF STORE=1
SET $PIECE(^TMP("SR",$JOB),"^",3)=$PIECE(^TMP("SR",$JOB),"^",3)+1
QUIT
+10 SET $PIECE(^TMP("SR",$JOB),"^")=$PIECE(^TMP("SR",$JOB),"^")+1
IF STORE=2
SET $PIECE(^TMP("SR",$JOB,REASON),"^")=$PIECE(^TMP("SR",$JOB,REASON),"^")+1
+11 IF 'AVOID
QUIT
+12 SET $PIECE(^TMP("SR",$JOB),"^",2)=$PIECE(^TMP("SR",$JOB),"^",2)+1
SET $PIECE(^TMP("SR",$JOB,REASON),"^",2)=$PIECE(^TMP("SR",$JOB,REASON),"^",2)+1
+13 QUIT
PAGE SET X=""
IF $EXTRACT(IOST)'="P"
WRITE !!!,"Press RETURN to continue, or '^' to quit: "
READ X:DTIME
IF '$TEST!(X["^")
SET SRSOUT=1
QUIT
+1 IF X["?"
WRITE !!,"Enter RETURN to continue printing this report, or '^' to exit from this option."
GOTO PAGE
HDR ; print heading
+1 IF $DATA(ZTQUEUED)
DO ^SROSTOP
IF SRHALT
SET SRSOUT=1
QUIT
+2 SET X=$EXTRACT(SRSD,4,5)_"/"_$EXTRACT(SRSD,6,7)_"/"_$EXTRACT(SRSD,2,3)
SET Y=$EXTRACT(SRED,4,5)_"/"_$EXTRACT(SRED,6,7)_"/"_$EXTRACT(SRED,2,3)
SET PAGE=PAGE+1
IF $Y
WRITE @IOF
+3 IF $EXTRACT(IOST)'="P"
QUIT
+4 WRITE !,?(80-$LENGTH(SRINST)\2),SRINST,?70,"PAGE: "_PAGE,!,?32,"SURGICAL SERVICE",!,?28,"CANCELLATION RATE REPORT",!,?27,"FROM "_X_" TO "_Y
+5 SET X=$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3)
WRITE !,?29,"DATE PRINTED: "_X
+6 WRITE !,?21,"REVIEWED BY:",?45,"DATE REVIEWED:",!
+7 WRITE !
FOR LINE=1:1:80
WRITE "="
+8 QUIT
SUB ; print column headings
+1 WRITE !!,"PRIMARY CANCELLATION REASON",?45,"TOTAL CANCELS",?62,"TOTAL AVOIDABLE",!
FOR LINE=1:1:80
WRITE "-"
+2 QUIT
