source: WorldVistAEHR/trunk/r/SURGERY-SR/SRORAT1.m@ 691

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

initial load of WorldVistAEHR

File size: 3.3 KB
RevLine 
[613]1SRORAT1 ;B'HAM ISC/MAM - CANCELLATION RATES, 1 SPECIALTY ; [ 04/06/00 10:19 AM ]
2 ;;3.0; Surgery ;**14,63,94**;24 Jun 93
3 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
4 S SRSOUT=1 Q
5SPEC K ^TMP("SR",$J),^TMP("SRT",$J) S SRHDR=0,^TMP("SR",$J)="0^0^0"
6 S SRSDATE=SRSD-.0001,SREDT=SRED+.9999,SRSSNM="** "_$P(^SRO(137.45,SRSS,0),"^")_" **"
7 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
8 D HDR Q:SRSOUT
9 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
10 S TCAN=$S(TOTAL>0:Y/TOTAL*100,1:0),TCAN=TCAN+.5\1*1,TPRCNT="CANCELLATION RATE FOR SCHEDULED CASES: "_TCAN_" %"
11 S SPRCNT="AVOIDABLE CANCELLATION RATE FOR SCHEDULED CASES: "_TOTRATE_" %"
12 S CPRCNT="AVOIDABLE CANCELLATION RATE FOR CANCELLED CASES: "_CANRATE_" %"
13 S TOTAL="TOTAL SCHEDULED SURGICAL CASES: "_TOTAL
14 S SRCOL=80-$L(SRSSNM)\2 W !!,?SRCOL,SRSSNM
15 W !!,TOTAL,!,TPRCNT,!,SPRCNT,!,CPRCNT D SUB
16 S REASON=0 F S REASON=$O(^TMP("SR",$J,REASON)) Q:REASON=""!(SRSOUT) D REASON
17 S X=$P(^TMP("SR",$J),"^"),Y=$P(^($J),"^",2)
18 W !,?47,"-----",?64,"-----",!,"TOTAL CANCELLATIONS",?47,$J(X,4),?64,$J(Y,4)
19 Q
20REASON I $Y+5>IOSL D PAGE Q:SRSOUT D SUB
21 S X=$P(^TMP("SR",$J,REASON),"^"),Y=$P(^(REASON),"^",2)
22 W !,$S($E(REASON,1,2)="ZZ":$E(REASON,3,45),1:REASON),?47,$J(X,4),?64,$J(Y,4)
23 Q
24UTIL ; set ^TMP
25 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
26 S X=$P(^SRF(SRTN,0),"^",4) I X'=SRSS Q
27 I $P($G(^SRF(SRTN,30)),"^") S STORE=2
28 I $P($G(^SRF(SRTN,31)),"^",8) S STORE=2
29 I $P($G(^SRF(SRTN,.2)),"^",12) S STORE=1,AVOID=""
30 I 'STORE Q
31 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,"^")
32 I STORE=2,'$D(^TMP("SR",$J,REASON)) S ^TMP("SR",$J,REASON)="0^0"
33 I STORE=1 S $P(^TMP("SR",$J),"^",3)=$P(^TMP("SR",$J),"^",3)+1 Q
34 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
35 I 'AVOID Q
36 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
37 Q
38PAGE S X="" I $E(IOST)'="P" W !!!,"Press RETURN to continue, or '^' to quit: " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q
39 I X["?" W !!,"Enter RETURN to continue printing this report, or '^' to exit from this option." G PAGE
40HDR ; print heading
41 I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q
42 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
43 I $E(IOST)'="P" Q
44 W !,?(80-$L(SRINST)\2),SRINST,?70,"PAGE: "_PAGE,!,?32,"SURGICAL SERVICE",!,?28,"CANCELLATION RATE REPORT",!,?27,"FROM "_X_" TO "_Y
45 S X=$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3) W !,?29,"DATE PRINTED: "_X
46 W !,?21,"REVIEWED BY:",?45,"DATE REVIEWED:",!
47 W ! F LINE=1:1:80 W "="
48 Q
49SUB ; print column headings
50 W !!,"CANCELLATION REASON",?45,"TOTAL CANCELS",?62,"TOTAL AVOIDABLE",! F LINE=1:1:80 W "-"
51 Q
Note: See TracBrowser for help on using the repository browser.