1 | SROAT2T ;B'HAM ISC/MAM - ATTENDING SURGEON CUMULATIVE ; [ 05/11/04 2:33 PM ]
|
---|
2 | ;;3.0; Surgery ;**50,129**;24 Jun 93
|
---|
3 | S SRPAGE=1
|
---|
4 | D HDR Q:SRSOUT W !!,?1,"TOTAL CASES",?16,"ATTENDING CODE",!,?1,"-----------",?16,"--------------"
|
---|
5 | S PRINT=1,(HDR,CODE)="" F I=0:0 S CODE=$O(^TMP("SRTC",$J,CODE)) Q:CODE="" D PRINT
|
---|
6 | W !!,?1,$J(^TMP("SRTOT",$J),6),?16,"TOTAL CASES FROM "_$E(SRSD,4,5)_"/"_$E(SRSD,6,7)_"/"_$E(SRSD,2,3)_" TO "_$E(SRED,4,5)_"/"_$E(SRED,6,7)_"/"_$E(SRED,2,3)
|
---|
7 | I $E(IOST)'="P" D BREAK I SRSOUT Q
|
---|
8 | S PRINT=2,SRSS=0 F S SRSS=$O(^TMP("SRTOT",$J,SRSS)) Q:SRSS=""!(SRSOUT) D SPEC
|
---|
9 | Q
|
---|
10 | PRINT I 'CODE S SRCODE="ATTENDING CODE NOT ENTERED"
|
---|
11 | I CODE S Y=CODE,C=$P(^DD(130,.166,0),"^",2) D Y^DIQ S SRCODE=Y
|
---|
12 | W !,?1,$J($S(PRINT=1:^TMP("SRTC",$J,CODE),1:^TMP("SRTOT",$J,SRSS,CODE)),6),?16,SRCODE
|
---|
13 | Q
|
---|
14 | HDR ; print heading
|
---|
15 | I +$Y W @IOF
|
---|
16 | W !,?(80-$L(SRINST)\2),SRINST,?76,"PAGE",!,?32,"SURGICAL SERVICE",?78,SRPAGE,!,?22,"ATTENDING SURGEON CUMULATIVE REPORT"
|
---|
17 | W !,?(80-$L(SRFRTO)\2),SRFRTO
|
---|
18 | I $E(IOST)="P" W !,?30,"DATE PRINTED: ",SRPRINT,!!,?8,"REVIEWED BY: ",?53,"DATE REVIEWED: "
|
---|
19 | S SRPAGE=SRPAGE+1 W ! F LINE=1:1:80 W "="
|
---|
20 | Q
|
---|
21 | BREAK W !!!,"Press RETURN to continue, or '^' to quit: " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q
|
---|
22 | I X["?" W !!,"Enter RETURN if you want to display the totals for each specialty, or '^' to",!,"exit from this report." G BREAK
|
---|
23 | Q
|
---|
24 | SPEC ; SPECIALTIES
|
---|
25 | S TOTAL=^TMP("SRTOT",$J,SRSS) I 'TOTAL Q
|
---|
26 | S SRSSN=$S($E(SRSS,1,2)="ZZ":"SPECIALTY NOT ENTERED",1:SRSS)
|
---|
27 | D HDR W !!,?(80-$L(SRSSN)\2),SRSSN,!!,?1,"TOTAL CASES",?16,"ATTENDING CODE",!,?1,"-----------",?16,"--------------"
|
---|
28 | S CODE="" F S CODE=$O(^TMP("SRTOT",$J,SRSS,CODE)) Q:CODE="" D PRINT
|
---|
29 | W !!,?1,$J(^TMP("SRTOT",$J,SRSS),6),?16,"TOTAL CASES FOR THIS SPECIALTY"
|
---|
30 | I $E(IOST)'="P" D BREAK I SRSOUT Q
|
---|
31 | Q
|
---|