Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SROWC3

SROWC3.m

Go to the documentation of this file.
SROWC3 ;B'HAM ISC/ADM - CLEAN WOUND INFECTION SUMMARY ; [ 07/27/98   2:33 PM ]
 ;;3.0; Surgery ;**50**;24 Jun 93
 S (SRCLEAN,SRCOMP,SRHDR,SRSOUT,SRSS)=0
 I 'SRSP D ALL G WC
 I SRSP D SPEC G WC
 Q
ALL F  S SRSS=$O(^SRO(137.45,SRSS)) Q:'SRSS  S (SRSS(SRSS),SRC(SRSS))=0
 S (SRSS("ZZ"),SRC("ZZ"))=0
 Q
SPEC F  S SRSS=$O(SRSP(SRSS)) Q:'SRSS  S (SRSS(SRSS),SRC(SRSS))=0
 Q
WC 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
 D HDR S SRSS="" F  S SRSS=$O(SRSS(SRSS)) Q:SRSS=""!(SRSOUT)  D PRINT G:SRSOUT END
 D:'SRSP TOTAL D END
 Q
SET Q:$P($G(^SRF(SROP,30)),"^")'=""  Q:$P($G(^SRF(SROP,.2)),"^",12)=""
 S SRSS=$P(^SRF(SROP,0),"^",4) S:SRSS="" SRSS="ZZ" I SRSP,'$D(SRSP(SRSS)) Q
 S SRWC=$P($G(^SRF(SROP,"1.0")),"^",8) I SRWC'="C" Q
 S SRC(SRSS)=SRC(SRSS)+1,SRCLEAN=SRCLEAN+1
 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
 I SRIN S SRSS(SRSS)=SRSS(SRSS)+1,SRCOMP=SRCOMP+1
 Q
PRINT ; print info
 I $Y+5>IOSL D HDR I SRSOUT Q
 S SRSPEC=$S(SRSS:$P(^SRO(137.45,SRSS,0),"^"),1:"NO SPECIALTY ENTERED")
 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),"%"
 Q
TOTAL ; print total
 W !!,"TOTAL",?27,$J(SRCLEAN,5),?42,$J(SRCOMP,5) S:SRCLEAN=0 SRCLEAN=1 W ?59,$J((SRCOMP/SRCLEAN*100),5,1),"%"
 Q
END W:$E(IOST)="P" @IOF I $D(ZTQUEUED) Q:$G(ZTSTOP)  S ZTREQ="@" Q
 I 'SRSOUT,$E(IOST)'="P" W !!,"Press RETURN to continue  " R X:DTIME
 D ^%ZISC,^SRSKILL W @IOF
 Q
HDR ; print heading
 I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q
 I $E(IOST)'="P",SRHDR W !!,"Press RETURN to continue or '^' to quit. " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q
 W:$Y @IOF W:$E(IOST)'="C" !,?(80-$L(SRINST)\2),SRINST,!,?32,"SURGICAL SERVICE" W !,?25,"CLEAN WOUND INFECTION SUMMARY"
 W !,?(80-$L(SRFRTO)\2),SRFRTO
 I $E(IOST)'="P" W ! F LINE=1:1:80 W "-"
 I $E(IOST)'="C" W !,?(80-$L(SRPRINT)\2),SRPRINT,!,?19,"REVIEWED BY:",?45,"DATE REVIEWED:"
 W !!,"SURGICAL SERVICE",?24,"CLEAN WOUNDS",?40,"INFECTIONS",?54,"INFECTION RATE",! I $E(IOST)'="C" F LINE=1:1:80 W "="
 S SRHDR=1
 Q