source: FOIAVistA/tag/r/SURGERY-SR/SROWC3.m@ 1806

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

initial load of FOIAVistA 6/30/08 version

File size: 2.2 KB
Line 
1SROWC3 ;B'HAM ISC/ADM - CLEAN WOUND INFECTION SUMMARY ; [ 07/27/98 2:33 PM ]
2 ;;3.0; Surgery ;**50**;24 Jun 93
3 S (SRCLEAN,SRCOMP,SRHDR,SRSOUT,SRSS)=0
4 I 'SRSP D ALL G WC
5 I SRSP D SPEC G WC
6 Q
7ALL F S SRSS=$O(^SRO(137.45,SRSS)) Q:'SRSS S (SRSS(SRSS),SRC(SRSS))=0
8 S (SRSS("ZZ"),SRC("ZZ"))=0
9 Q
10SPEC F S SRSS=$O(SRSP(SRSS)) Q:'SRSS S (SRSS(SRSS),SRC(SRSS))=0
11 Q
12WC F S SRSD=$O(^SRF("AC",SRSD)) Q:'SRSD!(SRSD>SRED) S SROP=0 F S SROP=$O(^SRF("AC",SRSD,SROP)) Q:'SROP I $D(^SRF(SROP,0)),$$MANDIV^SROUTL0(SRINSTP,SROP) D SET
13 D HDR S SRSS="" F S SRSS=$O(SRSS(SRSS)) Q:SRSS=""!(SRSOUT) D PRINT G:SRSOUT END
14 D:'SRSP TOTAL D END
15 Q
16SET Q:$P($G(^SRF(SROP,30)),"^")'="" Q:$P($G(^SRF(SROP,.2)),"^",12)=""
17 S SRSS=$P(^SRF(SROP,0),"^",4) S:SRSS="" SRSS="ZZ" I SRSP,'$D(SRSP(SRSS)) Q
18 S SRWC=$P($G(^SRF(SROP,"1.0")),"^",8) I SRWC'="C" Q
19 S SRC(SRSS)=SRC(SRSS)+1,SRCLEAN=SRCLEAN+1
20 S (SRC,SRIN)=0 F S SRC=$O(^SRF(SROP,16,SRC)) Q:'SRC S SRCAT=$P(^SRF(SROP,16,SRC,0),"^",2) I SRCAT=1!(SRCAT=2) S SRIN=1
21 I SRIN S SRSS(SRSS)=SRSS(SRSS)+1,SRCOMP=SRCOMP+1
22 Q
23PRINT ; print info
24 I $Y+5>IOSL D HDR I SRSOUT Q
25 S SRSPEC=$S(SRSS:$P(^SRO(137.45,SRSS,0),"^"),1:"NO SPECIALTY ENTERED")
26 W !,$P(SRSPEC,"("),?27,$J(SRC(SRSS),5),?42,$J(SRSS(SRSS),5) S:SRC(SRSS)=0 SRC(SRSS)=1 W ?59,$J((SRSS(SRSS)/SRC(SRSS)*100),5,1),"%"
27 Q
28TOTAL ; print total
29 W !!,"TOTAL",?27,$J(SRCLEAN,5),?42,$J(SRCOMP,5) S:SRCLEAN=0 SRCLEAN=1 W ?59,$J((SRCOMP/SRCLEAN*100),5,1),"%"
30 Q
31END W:$E(IOST)="P" @IOF I $D(ZTQUEUED) Q:$G(ZTSTOP) S ZTREQ="@" Q
32 I 'SRSOUT,$E(IOST)'="P" W !!,"Press RETURN to continue " R X:DTIME
33 D ^%ZISC,^SRSKILL W @IOF
34 Q
35HDR ; print heading
36 I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q
37 I $E(IOST)'="P",SRHDR W !!,"Press RETURN to continue or '^' to quit. " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q
38 W:$Y @IOF W:$E(IOST)'="C" !,?(80-$L(SRINST)\2),SRINST,!,?32,"SURGICAL SERVICE" W !,?25,"CLEAN WOUND INFECTION SUMMARY"
39 W !,?(80-$L(SRFRTO)\2),SRFRTO
40 I $E(IOST)'="P" W ! F LINE=1:1:80 W "-"
41 I $E(IOST)'="C" W !,?(80-$L(SRPRINT)\2),SRPRINT,!,?19,"REVIEWED BY:",?45,"DATE REVIEWED:"
42 W !!,"SURGICAL SERVICE",?24,"CLEAN WOUNDS",?40,"INFECTIONS",?54,"INFECTION RATE",! I $E(IOST)'="C" F LINE=1:1:80 W "="
43 S SRHDR=1
44 Q
Note: See TracBrowser for help on using the repository browser.