source: WorldVistAEHR/trunk/r/SURGERY-SR/SRORATA.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1SRORATA ;B'HAM ISC/MAM - CANCEL RATES ; [ 02/12/97 12:16 PM ]
2 ;;3.0; Surgery ;**63**;24 Jun 93
3 I 'SROTOT D PAGE I SRSOUT Q
4 I SROTOT D HDR Q:SRSOUT
5 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
6 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
7 W !!,"TOTAL SURGICAL CASES SCHEDULED FOR ",SRINST,": ",TOTAL
8 W !,"CANCELLATION RATE FOR SCHEDULED CASES: ",TCAN," %"
9 W !,"AVOIDABLE CANCELLATION RATE FOR SCHEDULED CASES: ",TOTRATE," %"
10 W !,"AVOIDABLE CANCELLATION RATE FOR CANCELLED CASES: ",CANRATE," %"
11 D SUB S REASON=0 F S REASON=$O(^TMP("SR",$J,REASON)) Q:REASON=""!(SRSOUT) D REASON
12 S X=$P(^TMP("SR",$J),"^"),Y=$P(^($J),"^",2)
13 W !,?47,"-----",?64,"-----",!,"TOTAL CANCELLATIONS",?47,$J(X,4),?64,$J(Y,4)
14 I $D(^TMP("SRT",$J)) D ^SRORATS
15 Q
16REASON I $Y+4>IOSL D PAGE Q:SRSOUT D SUB
17 S X=$P(^TMP("SR",$J,REASON),"^"),Y=$P(^(REASON),"^",2)
18 W !,$S($E(REASON,1,2)="ZZ":$E(REASON,3,45),1:REASON),?47,$J(X,4),?64,$J(Y,4)
19 Q
20PAGE I 'SRHDR S SRHDR=1 G HDR
21 S X="" I $E(IOST)'="P" W !!,"Press RETURN to continue, or '^' to quit: " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q
22 I X["?" W !!,"Enter RETURN to continue printing this report, or '^' to exit from this option." G PAGE
23HDR ; print heading
24 I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q
25 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
26 I $E(IOST)'="P" Q
27 W !,?(80-$L(SRINST)\2),SRINST,?70,"PAGE: "_PAGE,!,?32,"SURGICAL SERVICE",!,?28,"CANCELLATION RATE REPORT",!,?27,"FROM "_X_" TO "_Y
28 S X=$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3) W !,?29,"DATE PRINTED: "_X
29 W !,?21,"REVIEWED BY:",?45,"DATE REVIEWED:"
30 W ! F LINE=1:1:80 W "="
31 Q
32SUB ; print column headings
33 W !!,"CANCELLATION REASON",?45,"TOTAL CANCELS",?62,"TOTAL AVOIDABLE",! F LINE=1:1:80 W "-"
34 Q
Note: See TracBrowser for help on using the repository browser.