SRORATP ;B'HAM ISC/MAM - CANCEL RATES (CONT) ;[ 02/12/97 12:15 PM ]
;;3.0;Surgery;**63,182**;24 Jun 93;Build 49
I SROTOT D ^SRORATA Q
S (SRHDR,SRSS,SRSOUT,PAGE)=0
F S SRSS=$O(^TMP("SRT",$J,SRSS)) Q:SRSS=""!(SRSOUT) D SP
Q:SRSOUT D ^SRORATA
Q
SP D PAGE Q:SRSOUT S SRSSNM="** "_$S(SRSS'="ZZ":SRSS,1:"SURGICAL SPECIALTY NOT ENTERED")_" **"
S X=^TMP("SRT",$J,SRSS),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
S TOTRATE=$S(TOTAL>0:X/TOTAL*100,1:0),TOTRATE=TOTRATE+.5\1*1,TCAN=$S(TOTAL>0:Y/TOTAL*100,1:0),TCAN=TCAN+.5\1*1
S 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("SRT",$J,SRSS,REASON)) Q:REASON=""!(SRSOUT) D REASON
Q:SRSOUT I $Y+4>IOSL D PAGE Q:SRSOUT
S X=$P(^TMP("SRT",$J,SRSS),"^"),Y=$P(^(SRSS),"^",2)
W !,?47,"-----",?64,"-----",!,"TOTAL CANCELLATIONS",?47,$J(X,4),?64,$J(Y,4)
I $E(IOST)="P" W !! F LINE=1:1:80 W "="
W ! Q
REASON I $Y+4>IOSL D PAGE Q:SRSOUT D SUB
S X=$P(^TMP("SRT",$J,SRSS,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
PAGE I 'SRHDR S SRHDR=1 G HDR
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[HSRORATP 2331 printed Nov 22, 2024@17:55:37 Page 2
SRORATP ;B'HAM ISC/MAM - CANCEL RATES (CONT) ;[ 02/12/97 12:15 PM ]
+1 ;;3.0;Surgery;**63,182**;24 Jun 93;Build 49
+2 IF SROTOT
DO ^SRORATA
QUIT
+3 SET (SRHDR,SRSS,SRSOUT,PAGE)=0
+4 FOR
SET SRSS=$ORDER(^TMP("SRT",$JOB,SRSS))
if SRSS=""!(SRSOUT)
QUIT
DO SP
+5 if SRSOUT
QUIT
DO ^SRORATA
+6 QUIT
SP DO PAGE
if SRSOUT
QUIT
SET SRSSNM="** "_$SELECT(SRSS'="ZZ":SRSS,1:"SURGICAL SPECIALTY NOT ENTERED")_" **"
+1 SET X=^TMP("SRT",$JOB,SRSS)
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
+2 SET TOTRATE=$SELECT(TOTAL>0:X/TOTAL*100,1:0)
SET TOTRATE=TOTRATE+.5\1*1
SET TCAN=$SELECT(TOTAL>0:Y/TOTAL*100,1:0)
SET TCAN=TCAN+.5\1*1
+3 SET TPRCNT="CANCELLATION RATE FOR SCHEDULED CASES: "_TCAN_" %"
+4 SET SPRCNT="AVOIDABLE CANCELLATION RATE FOR SCHEDULED CASES: "_TOTRATE_" %"
+5 SET CPRCNT="AVOIDABLE CANCELLATION RATE FOR CANCELLED CASES: "_CANRATE_" %"
+6 SET TOTAL="TOTAL SCHEDULED SURGICAL CASES: "_TOTAL
+7 SET SRCOL=80-$LENGTH(SRSSNM)\2
WRITE !!,?SRCOL,SRSSNM
+8 WRITE !!,TOTAL,!,TPRCNT,!,SPRCNT,!,CPRCNT
DO SUB
+9 SET REASON=0
FOR
SET REASON=$ORDER(^TMP("SRT",$JOB,SRSS,REASON))
if REASON=""!(SRSOUT)
QUIT
DO REASON
+10 if SRSOUT
QUIT
IF $Y+4>IOSL
DO PAGE
if SRSOUT
QUIT
+11 SET X=$PIECE(^TMP("SRT",$JOB,SRSS),"^")
SET Y=$PIECE(^(SRSS),"^",2)
+12 WRITE !,?47,"-----",?64,"-----",!,"TOTAL CANCELLATIONS",?47,$JUSTIFY(X,4),?64,$JUSTIFY(Y,4)
+13 IF $EXTRACT(IOST)="P"
WRITE !!
FOR LINE=1:1:80
WRITE "="
+14 WRITE !
QUIT
REASON IF $Y+4>IOSL
DO PAGE
if SRSOUT
QUIT
DO SUB
+1 SET X=$PIECE(^TMP("SRT",$JOB,SRSS,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
PAGE IF 'SRHDR
SET SRHDR=1
GOTO HDR
+1 SET X=""
IF $EXTRACT(IOST)'="P"
WRITE !!!,"Press RETURN to continue, or '^' to quit: "
READ X:DTIME
IF '$TEST!(X["^")
SET SRSOUT=1
QUIT
+2 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
